Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
2559 lines (1957 sloc) 72.1 KB
#!/usr/bin/perl
use utf8;
use strict;
use warnings;
use Encode::Byte;
use Encode::Unicode;
use DBI;
use DBD::SQLite;
use Getopt::Long;
use File::Spec;
use File::Temp qw(tmpnam tempdir);
use POSIX qw(mktime strftime);
use Win32::OLE;
use Win32::OLE::Const 'Microsoft SourceSafe';
use IO::Pipe;
use IPC::Open2;
$| = 1;
our $dbh;
our $is_postgres = 0;
our ($opt_init, $opt_import, $opt_connect, $git_tree, $opt_newhead, $opt_nomaps);
our ($opt_dump, $opt_load, $authors_file, $filename_file);
our ($opt_rebase, $opt_nofetch, $opt_repin, $opt_undo_checkouts,
$opt_checkout, $opt_squash, $opt_commit, $opt_master,
$opt_sanitize, $opt_mergetool);
sub usage() {
print STDERR <<END;
Usage: git-vss [-h|--help] [--root=GIT_repository] parameters...
Update Git from VSS:
[--new-head] [--checkout] [--rebase] branchname
Commit changes from Git into VSS:
--commit [--squash=title[:]] [--mergetool=cmd] branchname
Undo previous checkouts:
--undo-checkouts [branchname]
Repin commits to the specified branch:
--repin branchname commit commit...
Initialize repository:
--connect base_path
(--init|--import=path) [--no-mappings] [--no-fetch] [--master=branch]
branchname vss_repo log_path log_offset < mappings.txt
(--load|--dump) [--authors=file] [--filenames=file]
Canonify newly-added file names in the index:
--sanitize-adds
END
exit(1);
}
GetOptions(
'help|h' => \&usage,
'root|C=s' => \$git_tree,
'init' => \$opt_init,
'import=s' => \$opt_import,
'connect' => \$opt_connect,
'no-mappings' => \$opt_nomaps,
'new-head' => \$opt_newhead,
'load' => \$opt_load,
'dump' => \$opt_dump,
'authors=s' => \$authors_file,
'filenames=s' => \$filename_file,
'rebase' => \$opt_rebase,
'no-fetch' => \$opt_nofetch,
'repin' => \$opt_repin,
'undo-checkouts' => \$opt_undo_checkouts,
'checkout' => \$opt_checkout,
'commit' => \$opt_commit,
'squash=s' => \$opt_squash,
'master=s' => \$opt_master,
'sanitize-adds' => \$opt_sanitize,
'mergetool=s' => \$opt_mergetool,
) or usage();
$opt_nofetch = 0 unless $opt_init || $opt_import;
our $base_path;
our $vss_path;
our $log_path;
our $log_offset;
our $initial_head;
our $branch_name;
our $vss;
our $vss_user;
our %vss_path_mapping;
our @vss_path_list;
# Chdir to the specified folder
$git_tree ||= ".";
chdir $git_tree;
# Path to the git repository root
my $git_dir = `git rev-parse --git-dir`;
($? == 0) or die "Bad working directory\n";
chomp $git_dir;
$git_dir = File::Spec->rel2abs($git_dir);
# Path to the working tree root
my $work_dir = $git_dir;
$work_dir =~ s/[\\\/]\.git$//;
# Add the git installation dir to the path
my $git_path = `git --exec-path`;
chomp $git_path;
$git_path =~ s/\//\\/g;
$ENV{PATH} .= ';' . $git_path;
my $win_path = $ENV{COMSPEC};
if ($win_path) {
$win_path =~ s/[\/\\][^\/\\]+$//;
$ENV{PATH} .= ';' . $win_path;
}
my $checkout_file = $git_dir.'/vss-checkouts';
my $squash_msg_file = $git_dir.'/vss-message';
###########################################################
# LOG SCANNING
sub fetch(\$*) {
my ($rp, $ra) = @_;
local $_;
while (<$ra>) {
return undef unless /\n$/;
$$rp .= $_;
s/\s+$//;
return $_;
}
return undef;
}
sub scan_log($$;$$) {
my ($processed, $log_fn, $handler, $on_error) = @_;
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($log_fn);
return -1 if ($size < $processed);
return $processed if $size == $processed;
open FH, '<:raw', $log_fn;
seek FH, $processed, 0;
my $active_proc = '';
my ($last_pos, $last_proc);
my @actions;
eval {
while (defined ($_ = fetch($active_proc, FH))) {
next if /^\s*$/;
if (/^(\$.*\S)$/) {
my $path = $1;
$path =~ s/^\$//;
defined ($_ = fetch($active_proc, FH)) or die "Incomplete block\n";
my $ver;
if (/^Version:\s+(\d+)/) {
$ver = $1;
defined ($_ = fetch($active_proc, FH)) or die "Incomplete block\n";
}
/^User:\s+(\S+)\s+Date:/ or die "Bad date line\n";
my $user = $1;
defined ($_ = fetch($active_proc, FH)) or die "Incomplete block\n";
my $cmd = $_;
my ($arg1,$arg2);
my $entry = {
path => $path,
version => $ver,
user => $user,
alterations => [],
};
if ($cmd =~ /^(.+) created$/) {
$cmd = 'Created';
$entry->{name} = $1;
} elsif ($cmd =~ /^(.+) added$/) {
$cmd = 'Added';
$entry->{name} = $1;
} elsif ($cmd =~ /^\$?(.+) deleted$/) {
$cmd = 'Deleted';
$entry->{name} = $1;
} elsif ($cmd =~ /^\$?(.+) destroyed$/) {
$cmd = 'Destroyed';
$entry->{name} = $1;
} elsif ($cmd =~ /^\$?(.+) purged$/) {
$cmd = 'Purged';
$entry->{name} = $1;
} elsif ($cmd =~ /^\$?(.+) archived$/) {
$cmd = 'Archived';
$entry->{name} = $1;
} elsif ($cmd =~ /^Restored version (\d+) to (\d+)$/) {
$cmd = 'Restored';
$entry->{name} = $2;
$entry->{obj_ver} = $1;
} elsif ($cmd =~ /^\$?(.+) recovered$/) {
$cmd = 'Recovered';
$entry->{name} = $1;
} elsif ($cmd =~ /^Labeled (.+)$/) {
$cmd = 'Labeled';
$entry->{label} = $1;
} elsif ($cmd =~ /^\$?(.+) shared from (\$.*)\/([^\/]*)$/) {
$cmd = 'Shared';
$entry->{name} = $1;
$entry->{src_path} =
($3 && lc(substr($1,0,length($3))) eq lc($3)) ? $2 : undef;
} elsif ($cmd =~ /^\$?(.+) copied from (\$.*)\/([^\/]+)$/) {
$cmd = 'Copied';
$entry->{name} = $1;
$entry->{src_path} =
($3 && lc(substr($1,0,length($3))) eq lc($3)) ? $2 : undef;
} elsif ($cmd =~ /^\$?(.+) moved to (\$.*)$/) {
$cmd = 'Moved';
$entry->{name} = $1;
$entry->{move_target} = $2;
} elsif ($cmd =~ /^(.+) renamed to (.+)$/) {
$cmd = 'Renamed';
$entry->{name} = $1;
$entry->{new_name} = $2;
} elsif ($cmd =~ /^Checked in$/) {
$cmd = 'Checked';
} elsif ($cmd =~ /^\$?(.+) branched$/) {
$cmd = 'Branched';
$entry->{name} = $1;
} else {
die "Unknown command: $cmd\n";
}
$entry->{command} = $cmd;
die "Version undefined\n" unless defined $ver;
my $comment;
defined ($_ = fetch($active_proc, FH)) or die "Incomplete block\n";
while (/\S/) {
$comment .= $_;
defined ($_ = fetch($active_proc, FH)) or die "Incomplete block\n";
}
$comment =~ s/^Comment: // if $comment;
$entry->{comment} = $comment;
my $ok = $handler ? $handler->($entry) : 1;
push @actions, $entry if $ok;
($last_pos, $last_proc) = ($processed, $active_proc);
$processed += length($active_proc);
$active_proc = '';
} else {
die "Invalid head line: $_\n";
}
}
};
if ($@) {
my $err = $@;
$active_proc = '';
$on_error->($err, $processed) if $on_error;
print STDERR $err;
}
$processed += length($active_proc);
close FH;
return wantarray ? ($processed, $last_pos, $last_proc, \@actions) : $processed;
}
###########################################################
# LOG ANALYSIS
sub matches($$) {
my ($path, $mask) = @_;
return 0 unless substr($path,0,length($mask)) eq $mask;
my $c = substr($path,length($mask),1);
return 0 if $c && $c ne '/';
return 1;
}
sub find_git_path($) {
my $vss_path = shift;
my $cpath = lc($vss_path);
for my $candidate (@vss_path_list) {
next unless matches($cpath, $candidate);
# Ignore list
return undef unless defined $vss_path_mapping{$candidate};
my $rpath = $vss_path_mapping{$candidate} . substr($vss_path, length($candidate));
$rpath =~ s/^\/+//;
return $rpath;
}
return undef;
}
sub read_log_tasks($$) {
my ($processed, $file) = @_;
my @actions;
my $handler = sub {
my ($entry) = @_;
# Move affects two paths, check the target one
if (defined $entry->{move_target}) {
die "Unsupported move into $entry->{move_target}\n"
if defined (find_git_path $entry->{move_target})
|| grep { matches($_, $entry->{move_target}); } @vss_path_list;
}
# Ignore actions that are outside of the defined mappings
defined ($entry->{git_path} = find_git_path $entry->{path})
or return 0;
if ($entry->{command} =~ /Renamed|Deleted|Recovered|Destroyed|Purged/) {
print STDERR "WARNING: $entry->{command} $entry->{path}/$entry->{name}\n";
push @{$_->{alterations}}, $entry for @actions;
}
# These commands change naming or versions, so bail out immediately
die "Unsupported command: $entry->{path} $entry->{command} $entry->{name}\n"
if $entry->{command} =~ /Moved|Restored/;
# Ignore no-op actions
return 0 if $entry->{command} =~ /Labeled|Archived|Branched|Created|Purged/;
push @actions, $entry;
return 1;
};
my ($rp, $lp, $lr, $lacts) = scan_log $processed, $file, $handler, sub {
my $msg = $_[0];
return if $msg eq "Incomplete block\n";
die $msg;
};
return $rp, $lacts;
}
###########################################################
# VSS HISTORY ANALYSIS
sub get_timestamp($) {
my $ver = shift;
return undef unless $ver;
my $date = $ver->{Date};
my $str = $date->Date('yyyy-MM-dd ').$date->Time('HH:mm:ss');
$str =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/;
return mktime($6, $5, $4, $3, $2-1, $1-1900, 0, 0, -1);
}
sub get_last_before($$) {
my ($item, $time) = @_;
return undef unless $item;
my $vset = $item->Versions(VSSFLAG_HISTIGNOREFILES);
my $enum = Win32::OLE::Enum->new($vset);
while (defined (my $ver = $enum->Next())) {
next if $ver->{Action} =~ /^Label/;
return $ver if get_timestamp $ver <= $time;
}
return undef;
}
sub get_last_by_text($$) {
my ($item, $action_text) = @_;
return undef unless $item;
my $vset = $item->Versions(VSSFLAG_HISTIGNOREFILES);
my $enum = Win32::OLE::Enum->new($vset);
while (defined (my $ver = $enum->Next())) {
next unless $ver->{Action} eq $action_text;
return $ver;
}
return undef;
}
sub get_version_at($$) {
my ($item, $idx) = @_;
return undef unless $item;
my $vset = $item->Versions(VSSFLAG_HISTIGNOREFILES);
my $entry = $vset->Item($idx);
if ($entry && $entry->{Action} =~ /^Label/) {
$entry = undef;
my $enum = Win32::OLE::Enum->new($vset);
while (defined (my $ver = $enum->Next())) {
next if $ver->{Action} =~ /^Label/;
last if $ver->{VersionNumber} < $idx;
next if $ver->{VersionNumber} > $idx;
$entry = $ver;
last;
}
}
return $entry;
}
sub alter_path($$;$) {
my ($alt_list, $path, $name) = @_;
my $ret_name = defined $name;
my $isdel = 0;
$path .= '/'.$name if $ret_name;
for my $item (@$alt_list) {
next unless lc $path eq lc($item->{path}.'/'.$item->{name});
if ($item->{command} eq 'Renamed') {
next if $isdel;
$path = $item->{path}.'/'.$item->{new_name};
} elsif ($item->{command} eq 'Deleted') {
$isdel = 1;
} elsif ($item->{command} eq 'Recovered') {
$isdel = 0;
} elsif ($item->{command} eq 'Destroyed') {
$isdel = -1;
last;
} elsif ($item->{command} eq 'Purged') {
next unless $isdel;
$isdel = -1;
last;
} else {
die "Invalid alteration: $item->{command}";
}
}
if ($ret_name) {
$path =~ /\/([^\/]+)$/ or die "Invalid path $path";
return ($1, $isdel);
} else {
return ($path, $isdel);
}
}
my $action_lookup_stmt;
# Binds a log entry to the actual VSS history
sub convert_action($) {
my ($entry) = @_;
# Account for later renames
my ($act_path, $act_del) = alter_path $entry->{alterations}, $entry->{path};
if ($act_del < 0) {
print STDERR "Skipping $entry->{command} on $entry->{path} - object destroyed.\n";
return undef;
}
my $msg_path = $act_path eq $entry->{path} ? $entry->{path} : "$entry->{path} ($act_path)";
# Find the item, and extract the named version
my $vss_item = $vss->VSSItem('$'.$act_path, $act_del)
or die "Cannot find item \$$msg_path";
my $item_version = get_version_at $vss_item, $entry->{version};
if ($entry->{command} eq 'Renamed') {
my $text = 'Renamed '.$entry->{name}.' to '.$entry->{new_name};
$item_version = get_last_by_text $vss_item, $text
unless $item_version && $item_version->{Action} eq $text;
print STDERR
"VSS BUG: Rename logged as $entry->{version}, ".
"actually $item_version->{VersionNumber}\n"
if $item_version &&
$item_version->{VersionNumber} != $entry->{version};
} elsif ($entry->{command} eq 'Copied') {
$item_version = get_version_at $vss_item, $entry->{version}-1
unless $item_version &&
$item_version->{Action} =~ /^Shared .*\/([^\/]+)$/ &&
$1 eq $entry->{name};
}
die "Cannot find version \$$msg_path:$entry->{version}\n" unless $item_version;
# Verify the action - it must match the logged one
my $item_action = $item_version->{Action};
my $item_command;
my $pin_version;
if ($item_action =~ /^Pinned.*to version (\d+)$/) {
$item_command = 'Shared';
$pin_version = $1;
} elsif ($item_action =~ /^Unpinned/) {
$item_command = 'Shared';
$entry->{unpin} = 1;
} elsif ($item_action =~ /^(\S+)/) {
$item_command = $1;
}
$item_command = 'Copied'
if $item_command eq 'Shared' && $entry->{command} eq 'Copied';
die "Command mismatch: $item_action vs $entry->{command} at \$$msg_path:$entry->{version}\n"
unless $item_command eq $entry->{command};
# Check if this action is known to have been done via git-vss
$action_lookup_stmt = $dbh->prepare(
'SELECT vss_action FROM known_actions '.
'WHERE vss_physid = ? AND vss_version = ? AND is_imported = 0'
)
unless $action_lookup_stmt;
$action_lookup_stmt->execute(
$item_version->{VSSItem}->{Physical},
$item_version->{VersionNumber}
);
if (my $row = $action_lookup_stmt->fetchrow_arrayref()) {
$row->[0] = $item_command
if $row->[0] eq 'Added' && $item_command eq 'Recovered';
($row->[0] eq $item_command)
or die "$entry->{path}:$entry->{version} - mismatch with known '$row->[0]':\n$item_action\n";
print STDERR "$entry->{path}:$entry->{version} - known, skipping.\n";
return undef;
}
# Prepare data to add this action into the table
$entry->{known_action_info} = [
$item_version->{VSSItem}->{Physical},
$item_version->{VersionNumber},
$item_command,
$entry->{git_path}
];
# Process the action in detail
if ($entry->{command} =~ /Deleted|Destroyed/) {
print STDERR "del $entry->{path}/$entry->{name}\n";
return [ 'del', $entry->{git_path}.'/'.$entry->{name}, $item_version, $entry ];
} elsif ($entry->{command} eq 'Checked') {
print STDERR "edit $entry->{path}:$entry->{version}\n";
return [ 'edit', $entry->{git_path}, $item_version, $entry ];
} elsif ($entry->{command} eq 'Renamed') {
print STDERR "rename $entry->{path}/$entry->{name} -> $entry->{new_name}\n";
return [ 'rename:'.$entry->{new_name}, $entry->{git_path}."/".$entry->{name},
$item_version, $entry ];
} else {
my $subpath = $entry->{git_path}.'/'.$entry->{name};
my ($act_name, $act_fdel) = alter_path $entry->{alterations}, $entry->{path}, $entry->{name};
if ($act_fdel < 0) {
print STDERR "Skipping $entry->{command} on $entry->{path}/$entry->{name} - object destroyed.\n";
return undef;
}
my $file_item = $item_version->{VSSItem}->Child($entry->{name}, 0)
or die "$entry->{name} not found in $act_path:$entry->{version}\n";
if ($entry->{command} eq 'Added') {
print STDERR "add $subpath:1\n";
return [ 'add', $subpath, get_version_at($file_item, 1), $entry ];
} elsif ($entry->{command} =~ /Shared|Recovered|Copied/) {
die "Sharing/recovering a folder"
if $file_item->{Type} == VSSITEM_PROJECT;
my $ver = $pin_version
? get_version_at($file_item, $pin_version)
: get_last_before($file_item, get_timestamp ($item_version));
print STDERR "share/add $subpath:$ver->{VersionNumber}\n";
return [ 'share', $subpath, $ver, $entry,
get_timestamp($item_version),
($entry->{command} eq 'Shared' ? $ver->{Username}.': ' : '') . $ver->{Comment},
$item_version->{Username} ];
} else {
die "Invalid command $entry->{command}\n";
}
}
}
###########################################################
# FILENAMES
my %canonical_dirs;
my %canonical_files;
my $get_file_stmt;
my $add_file_stmt;
my $mark_dir_stmt;
sub fetch_file_names() {
return if $add_file_stmt;
$dbh->do('LOCK TABLE file_names IN ROW EXCLUSIVE MODE') if $is_postgres;
$add_file_stmt = $dbh->prepare('INSERT INTO file_names VALUES (?, ?, ?)');
$mark_dir_stmt = $dbh->prepare('UPDATE file_names SET is_folder = 1 WHERE key_name = ?');
%canonical_dirs = ();
%canonical_files = ();
for my $line (@{$dbh->selectall_arrayref(<<QUERY)})
SELECT key_name, canonical_name, is_folder FROM file_names
QUERY
{
if ($line->[2]) {
$canonical_dirs{$line->[0]} = 1;
}
$canonical_files{$line->[0]} = $line->[1];
}
}
sub open_file_names() {
return if $add_file_stmt;
$dbh->do('LOCK TABLE file_names IN ROW EXCLUSIVE MODE') if $is_postgres;
$get_file_stmt = $dbh->prepare('SELECT canonical_name, is_folder FROM file_names WHERE key_name = ?');
$add_file_stmt = $dbh->prepare('INSERT INTO file_names VALUES (?, ?, ?)');
$mark_dir_stmt = $dbh->prepare('UPDATE file_names SET is_folder = 1 WHERE key_name = ?');
%canonical_dirs = ();
%canonical_files = ();
}
sub add_file_path($;$) {
my ($new_path, $is_dir) = @_;
my $lnew_path = lc $new_path;
if ($canonical_files{$lnew_path}) {
if ($is_dir && !$canonical_dirs{$lnew_path}) {
$canonical_dirs{$lnew_path} = 1;
$mark_dir_stmt->execute($lnew_path);
}
return $canonical_files{$lnew_path};
}
if ($get_file_stmt) {
$get_file_stmt->execute($lnew_path);
my $row = $get_file_stmt->fetchrow_arrayref();
if ($row) {
my ($name, $fldr) = @$row;
$canonical_dirs{$lnew_path} = 1 if $fldr;
return $canonical_files{$lnew_path} = $name;
}
}
my $npath;
if ($new_path =~ /^(.+)\/([^\/]+)$/) {
my ($dir, $file) = ($1, $2);
$npath = &add_file_path($dir, 1).'/'.$file;
} else {
$npath = $new_path;
}
$canonical_dirs{$lnew_path} = 1 if $is_dir;
$add_file_stmt->execute($lnew_path, $npath, $is_dir||0);
return $canonical_files{$lnew_path} = $npath;
}
sub force_file_names($$$) {
my ($dir, $oldpath, $newpath) = @_;
my @oldlist = split /\//, $oldpath;
my @newlist = split /\//, $newpath;
die "Invalid path pair: $oldpath -> $newpath\n"
unless @oldlist == @newlist && length($oldpath) == length($newpath);
while (@oldlist) {
rename $dir.'/'.$oldlist[0], $dir.'/'.$newlist[0]
unless $oldlist[0] eq $newlist[0];
$dir .= '/'.$newlist[0];
shift @oldlist;
shift @newlist;
}
}
sub sanitize_adds() {
open_file_names();
open FH, "git-diff-index --diff-filter=A HEAD |"
or die "Could not list added files\n";
while (<FH>) {
chomp;
/^:(\d+) (\d+) ([a-f0-9]+) ([a-f0-9]+) (A)\t(.*)$/
or die "Bad diff line: $_";
my ($omode, $nmode, $oblob, $nblob, $op, $name) = ($1, $2, $3, $4, $5, $6);
my $path = add_file_path $name;
unless ($path eq $name) {
print STDERR "Invalid addition $name, must be $path\n";
system 'git-update-index', '--add', '--cacheinfo', $nmode, $nblob, $path;
($? == 0) or die "Index update failed\n";
system 'git-update-index', '--force-remove', $name;
force_file_names $work_dir, $name, $path;
}
}
}
my %current_files;
sub load_tree_listing($) {
my $tree = shift;
fetch_file_names();
%current_files = ();
open TREE, "git ls-tree -r --name-only --full-name $tree |";
while (<TREE>) {
chomp;
$current_files{lc $_} = $_;
my $path = add_file_path $_;
print STDERR "Filename mismatch: $_ vs canonical $path\n"
unless $path eq $_;
}
close TREE;
}
###########################################################
# AUTHORS
my %author_table;
sub load_author_table() {
$author_table{$_->[0]} = [ $_->[1], $_->[2] ]
for @{$dbh->selectall_arrayref(<<QUERY)};
SELECT vss_user, real_name, real_email FROM vss_users
QUERY
}
###########################################################
# GIT IMPORT
sub cache_file($$) {
my ($item, $path) = @_;
unless ($item && $item->{VSSItem}) {
print STDERR " - no data, skipping\n";
return;
}
unless ($item->{VSSItem}->{Type} == VSSITEM_FILE) {
die "Trying to cache a project: $item->{VSSItem}->{Spec} as $path";
}
my $name = tmpnam();
unlink $name;
$item->{VSSItem}->Get($name, VSSFLAG_FORCEDIRNO);
unless (-e $name) {
print STDERR " - get failed, skipping\n";
return;
}
my $sha = `git-hash-object -w \"$name\"`;
chomp $sha;
unlink $name;
system 'git-update-index', '--add', '--cacheinfo', '0644', $sha, $path;
}
sub cache_rename_file($$) {
my ($old_path, $new_path) = @_;
return if $old_path eq $new_path;
my $rv = `git-ls-files --stage -- \"$old_path\"`;
chomp $rv;
unless ($? == 0 && $rv =~ /^(\d+) ([a-f0-9]+) \d+\t(.+)$/) {
print STDERR " - old file not found for rename: $old_path\n";
return;
}
my ($mode, $sha, $name) = ($1, $2, $3);
$name eq $old_path
or die "Invalid ls-files result: $name instead of $old_path\n";
system 'git-update-index', '--force-remove', $old_path;
system 'git-update-index', '--add', '--cacheinfo', $mode, $sha, $new_path;
}
sub exec_action($\%\%\%%) {
my ($action, $delmap, $editmap, $cleanmap, %flags) = @_;
$action->[1] =~ s/^\/+//;
my $path = $current_files{lc $action->[1]};
if ($action->[0] eq 'del') {
unless ($path) {
print STDERR "Deleting unknown file $action->[1]\n";
return -1;
}
return 0 if $editmap->{$path} || $delmap->{$path};
$delmap->{$path}++;
return 2 if $flags{-no_exec};
$cleanmap->{$path}++;
print STDERR "Deleting $path\n";
system 'git-update-index', '--force-remove', $path;
} elsif ($action->[0] eq 'edit') {
unless ($path) {
print STDERR "Editing unknown file $action->[1] - adding\n";
$path = $current_files{lc $action->[1]} = add_file_path $action->[1];
}
return 0 if $editmap->{$path} || ($flags{-no_exec} && $delmap->{$path});
delete $delmap->{$path};
$editmap->{$path}++;
return 2 if $flags{-no_exec};
print STDERR "Editing $path\n";
cache_file $action->[2], $path;
} elsif ($action->[0] eq 'add' || $action->[0] eq 'share') {
$path = $current_files{lc $action->[1]} = add_file_path $action->[1]
unless $path;
return 0 if $editmap->{$path} || ($flags{-no_exec} && $delmap->{$path});
delete $delmap->{$path};
$editmap->{$path}++ unless $action->[3]->{unpin};
return 2 if $flags{-no_exec};
print STDERR "Adding $path\n";
cache_file $action->[2], $path;
} elsif ($action->[0] =~ /^rename:(.+)$/) {
my $new_name = $1;
$action->[1] =~ /^(.*)\/([^\/]+)$/;
my ($dir, $old_name) = ($1, $2);
$path = $current_files{lc $action->[1]} = add_file_path $action->[1]
unless $path;
my $new_path = add_file_path $dir.'/'.$new_name;
return 0 if $editmap->{$path} || $delmap->{$path} ||
$editmap->{$new_path} || $delmap->{$new_path};
$editmap->{$path}++;
$delmap->{$path}++;
$editmap->{$new_path}++;
return 2 if $flags{-no_exec};
$cleanmap->{$path}++;
print STDERR "Renaming $path to $new_path\n";
cache_rename_file $path, $new_path;
} else {
die "Invalid action '$action->[0]'";
}
return 1;
}
sub run_commit_tree($$@) {
my ($comment, $tree, @parents) = @_;
my $name = tmpnam();
open FH, '>', $name;
print FH $comment;
close FH;
my $parents = join('', map { ' -p '.$_; } @parents);
my $cmd = "git-commit-tree $tree $parents < \"$name\"";
#print "$_ => $ENV{$_}\n" for keys %ENV;
#print "$cmd\n";
my $rv = `$cmd`;
unlink $name;
die "Could not run git-commit-tree\n" if $?;
chomp $rv;
die "Invalid result of git-commit-tree: $rv\n" unless length($rv) == 40;
return $rv;
}
sub make_commit($\@) {
my ($old_head, $ractions) = @_;
my @commit_actions;
my %delmap;
my %editmap;
my %cleanmap;
# Find the first valid action
my $action;
do {
$action = shift @$ractions or return $old_head;
} while (exec_action($action, %delmap, %editmap, %cleanmap) <= 0);
push @commit_actions, $action;
# Main scan:
my $user = $action->[6];
my $time = $action->[4];
my $comment = $action->[0] eq 'share' ? undef : $action->[5];
my %shared_comments;
for (my $i = 0; $i <= $#$ractions; ) {
my $cur_action = $ractions->[$i];
# Stop if the time range is exceeded
$time ||= $cur_action->[4];
last if $cur_action->[4] && ($cur_action->[4] - $time) > 3600;
# Stop on actions of different users that clash with the current commit.
# Otherwise skip to redo later.
if ($cur_action->[6] ne $user) {
last if exec_action($cur_action, %delmap, %editmap, %cleanmap, -no_exec => 1) == 0;
$i++;
next;
}
# Unpin comments are ignored;
unless ($cur_action->[3]->{unpin}) {
# Share actions batch comments for individual files together
if ($cur_action->[0] eq 'share') {
last if $comment;
$shared_comments{$cur_action->[5]}++;
} else {
last if %shared_comments && $cur_action->[5];
# Break on changing comment for ordinary updates
$comment ||= $cur_action->[5];
last if $cur_action->[5] && $cur_action->[5] ne $comment;
}
}
# Execute the action, or stop on conflict
last if exec_action($cur_action, %delmap, %editmap, %cleanmap) == 0;
push @commit_actions, splice(@$ractions, $i, 1);
}
$comment = join("\n", sort keys %shared_comments)
if %shared_comments;
#delete $current_files{lc $_} for keys %cleanmap;
# Store the tree
my $tree_sha = `git-write-tree`;
chomp $tree_sha;
die "Failed to write tree: $tree_sha" unless length($tree_sha) == 40;
# Create a commit object
local $ENV{GIT_AUTHOR_NAME} = $author_table{lc $user}[0] || $user;
local $ENV{GIT_AUTHOR_EMAIL} = $author_table{lc $user}[1] || $user;
local $ENV{GIT_AUTHOR_DATE} = strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($time));
local $ENV{GIT_COMMITTER_NAME} = $author_table{lc $user}[0] || $user;
local $ENV{GIT_COMMITTER_EMAIL} = $author_table{lc $user}[1] || $user;
local $ENV{GIT_COMMITTER_DATE} = strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($time));
$comment ||= '--none--';
my $sha = run_commit_tree $comment, $tree_sha, $old_head;
# Log the actions into the db for future use
$dbh->prepare(
'INSERT INTO known_commits '.
'(commit_id, branch_name, parent_id, is_imported) '.
'VALUES (?, ?, ?, 1)'
)->execute(
$sha, $branch_name, $old_head
);
my $del_stmt = $dbh->prepare(
'DELETE FROM known_actions WHERE vss_physid = ? AND vss_version = ?'
);
my $ins_stmt = $dbh->prepare(
'INSERT INTO known_actions '.
'(vss_physid, vss_version, vss_action, git_path, commit_id, is_imported) '.
'VALUES (?, ?, ?, ?, ?, 1)'
);
$del_stmt->execute(@{$_->[3]{known_action_info}}[0..1])
for grep { $_->[0] =~ /^rename:/; } @commit_actions;
$ins_stmt->execute(@{$_->[3]{known_action_info}}[0..3], $sha)
for @commit_actions;
# Done
print STDERR " == $user $time\n";
return $sha;
}
sub fetch_remote_head() {
return if $base_path eq '.';
system 'git-fetch', $base_path, '+refs/heads/'.$branch_name.':refs/remotes/vss/'.$branch_name;
($? == 0) or die "Could not fetch remote head.\n";
}
sub push_remote_head() {
return if $base_path eq '.';
system 'git-push', $base_path, $initial_head.':refs/heads/'.$branch_name;
($? == 0) or die "Could not push new head to the common store.\n";
}
sub set_local_head($) {
my $head = shift;
if ($base_path eq '.') {
system 'git-branch', '-f', $branch_name, $head;
($? == 0) or die "Could not set local branch.\n";
} else {
my $fpath = $git_dir.'/refs/remotes/vss/';
die "Local ref directory does not exist: $fpath" unless -d $fpath;
open FH, '>:raw', $fpath.$branch_name;
print FH "$head\n";
close FH;
}
$initial_head = $head;
}
sub fetch_data(%) {
my (%flags) = @_;
print STDERR "Fetching...\n";
# Read the log
my ($rp, $acts) = read_log_tasks $log_offset, $log_path;
die "FATAL: The log was rotated.\n" if $rp < $log_offset;
return 0 if $rp == $log_offset;
if (@$acts) {
# Match log entries to the VSS history
my @cacts =
grep { defined $_ }
map {
my $info = convert_action($_);
if(defined $info && $info->[0] ne 'share') {
$info->[4] = get_timestamp($info->[2]) if $info->[2];
$info->[5] = $info->[2] ? $info->[2]->{Comment} : $info->[3]->{comment};
$info->[6] = $info->[2] ? $info->[2]->{Username} : $info->[3]->{user};
}
$info;
} @$acts;
my $head = $initial_head;
# Execute commits
if (@cacts) {
# Use separate index file
local $ENV{GIT_INDEX_FILE} = tmpnam();
system 'git-read-tree', $head;
eval {
load_tree_listing $head;
load_author_table;
$head = make_commit $head, @cacts
while @cacts;
};
my $rv = $@;
unlink $ENV{GIT_INDEX_FILE};
die $rv if $rv;
}
# Update the branch
unless ($initial_head eq $head) {
set_local_head($head);
push_remote_head() unless $opt_commit;
}
}
$log_offset = $rp;
return 1;
}
sub rec_add_files(\@$$);
sub rec_add_files(\@$$) {
my ($robjlist, $dirpath, $reppath) = @_;
opendir DIR, $dirpath;
my @files = readdir DIR;
closedir DIR;
for my $fname (@files) {
next if $fname =~ /^\.+$/;
next if $fname =~ /^\.(?:svn|git)$/;
next if $fname =~ /s[sc]c$/;
my $dirfile = $dirpath . "\\" . $fname;
my $repfile = $reppath ? $reppath . '/' . $fname : $fname;
if (-d $dirfile) {
rec_add_files @$robjlist, $dirfile, $repfile;
} else {
my $path = add_file_path $repfile;
print STDERR "\r$path ";
my $sha = `git-hash-object -w \"$dirfile\"`;
chomp $sha;
die "Failed to add object\n" unless length($sha) == 40;
push @$robjlist, [ $sha, $path ];
}
}
}
sub create_initial_branch {
local $ENV{GIT_INDEX_FILE} = tmpnam();
my @objects;
rec_add_files @objects, $opt_import, '';
while (@objects) {
my @part;
if (@objects > 12) {
@part = splice @objects, 0, 12;
} else {
@part = @objects;
@objects = ();
}
system "git-update-index", "--add",
map { ("--cacheinfo", "0644", $_->[0], $_->[1]); } @part;
}
my $tree_sha = `git-write-tree`;
chomp $tree_sha;
die "Failed to write tree: $tree_sha" unless length($tree_sha) == 40;
my $sha = run_commit_tree "Initializing branch $branch_name\n", $tree_sha;
unlink $ENV{GIT_INDEX_FILE};
$dbh->prepare(
'INSERT INTO known_commits '.
'(commit_id, branch_name, parent_id, is_imported) '.
'VALUES (?, ?, NULL, 0)'
)->execute(
$sha, $branch_name
);
system 'git-branch', $branch_name, $sha;
$initial_head = $sha;
}
###########################################################
# DATABASE
sub create_tables() {
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS vss_branches (
branch_name TEXT NOT NULL,
repo_path TEXT NOT NULL,
log_path TEXT NOT NULL,
current_head TEXT NOT NULL,
log_offset INTEGER NOT NULL,
checkin_branch TEXT,
PRIMARY KEY (branch_name)
)
QUERY
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS vss_mappings (
branch_name TEXT NOT NULL,
vss_path TEXT NOT NULL,
git_path TEXT,
PRIMARY KEY (branch_name, vss_path)
)
QUERY
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS vss_users (
vss_user TEXT NOT NULL,
real_name TEXT NOT NULL,
real_email TEXT NOT NULL,
PRIMARY KEY (vss_user)
)
QUERY
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS file_names (
key_name TEXT NOT NULL,
canonical_name TEXT NOT NULL,
is_folder INTEGER NOT NULL,
PRIMARY KEY (key_name)
)
QUERY
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS known_actions (
vss_physid TEXT NOT NULL,
vss_version INTEGER NOT NULL,
vss_action TEXT NOT NULL,
git_path TEXT NOT NULL,
commit_id TEXT NOT NULL,
is_imported INTEGER NOT NULL DEFAULT 1,
PRIMARY KEY (vss_physid, vss_version)
)
QUERY
$dbh->do(<<QUERY);
CREATE INDEX IF NOT EXISTS ICommitActions ON known_actions(commit_id)
QUERY
$dbh->do(<<QUERY);
CREATE TABLE IF NOT EXISTS known_commits (
commit_id TEXT NOT NULL,
branch_name TEXT NOT NULL,
parent_id TEXT,
is_imported INTEGER NOT NULL DEFAULT 1,
PRIMARY KEY (commit_id)
)
QUERY
}
sub load_mappings() {
%vss_path_mapping = ();
for my $line (@{$dbh->selectall_arrayref(<<QUERY)})
SELECT vss_path, git_path FROM vss_mappings
WHERE branch_name = @{[$dbh->quote($branch_name)]}
QUERY
{
$vss_path_mapping{lc $line->[0]} = $line->[1];
}
@vss_path_list = reverse sort keys %vss_path_mapping
or die "Could not load mappings\n";
}
sub load_other_mappings($) {
my $branch = shift;
return undef unless $branch;
local %vss_path_mapping;
local @vss_path_list;
local $branch_name = $branch;
load_mappings();
return { %vss_path_mapping };
}
sub import_mappings() {
my $ist = $dbh->prepare('INSERT INTO vss_mappings VALUES (?, ?, ?)');
my $fh = \*STDIN;
if ($ARGV[0]) {
open $fh, $ARGV[0]
or die "Cannot open $ARGV[0]\n";
shift @ARGV;
}
$dbh->prepare('DELETE FROM vss_mappings WHERE branch_name = ?')
->execute($branch_name);
while (<$fh>) {
chomp;
next if /^\s*(?:\#.*)?$/;
if (/^\s*(\/[^:]+[^\/:\s])\/?\s*[:=]\s*(?:\/(\S*)|(IGNORE))\s*$/) {
my ($bpath, $rpath, $ignore) = ($1, $2||'', $3);
$bpath =~ s/\/+$//;
$rpath =~ s/\/+$//;
$rpath ||= '/';
$ist->execute($branch_name, lc $bpath, $ignore ? undef : $rpath);
} else {
die "Invalid path mapping: $_\n";
}
}
}
sub load_name_tree($;$) {
my ($tree, $path) = @_;
for my $item (values %$tree) {
$item->[0] =~ s/\.([^\.]+)$/'.'.lc($1)/e
unless %{$item->[1]};
my $subpath = $path ? $path.'/'.$item->[0] : $item->[0];
my $rpath = add_file_path $subpath;
print STDERR "\rMismatch: $rpath " unless $rpath eq $subpath;
&load_name_tree($item->[1], $subpath);
}
}
sub load_data() {
if ($authors_file) {
open DUMP, $authors_file
or die "Cannot open $authors_file\n";
$dbh->do('LOCK TABLE vss_users IN ROW EXCLUSIVE MODE') if $is_postgres;
my $del_stmt = $dbh->prepare('DELETE FROM vss_users WHERE vss_user = ?');
my $upd_stmt = $dbh->prepare('INSERT INTO vss_users (vss_user, real_name, real_email) VALUES (?, ?, ?)');
while (<DUMP>) {
chomp;
next if /^\s*(?:\#.*)?$/;
/^\s*(\S+)\s*=\s*([^\<\s][^\<]+[^\<\s])\s*<\s*([^\>\s][^\>]+[^\>\s])\s*>\s*$/
or die "Invalid user file format: $_\n";
my ($user, $name, $email) = ($1, $2, $3);
$del_stmt->execute(lc $user);
$upd_stmt->execute(lc $user, $name, $email);
}
close DUMP;
}
if ($filename_file) {
open DUMP, $filename_file
or die "Cannot open $filename_file\n";
my %nametable;
while (<DUMP>) {
chomp;
s/^\s*\/*//;
s/\/*\s*$//;
next if $_ eq '';
my $tree = \%nametable;
for my $item (split /\//, $_) {
my $entry = ($tree->{lc $item} ||= [$item, {}, {$item => 1}]);
if ($entry->[0] ne $item && !$entry->[2]{$item}) {
$entry->[2]{$item}++;
my $cup = uc($entry->[0]) eq $entry->[0];
my $clo = lc($entry->[0]) eq $entry->[0];
my $nup = uc($item) eq $item || ($item =~ /\.[^\.]*[A-Z][^\.]$/);
if ($cup || ($clo && !$nup)) {
$entry->[0] = $item;
} else {
print STDERR "Old: $entry->[0], New: $item\nSwitch [y/n]? ";
my $rv = <STDIN>;
$entry->[0] = $item if $rv =~ /[Yy]/;
}
}
$tree = $entry->[1];
}
}
fetch_file_names();
load_name_tree \%nametable;
close DUMP;
}
$dbh->do('COMMIT');
}
sub dump_data() {
if ($authors_file) {
open DUMP, '>', $authors_file;
print DUMP "$_->[0] = $_->[1] <$_->[2]>\n"
for @{$dbh->selectall_arrayref(<<QUERY)};
SELECT vss_user, real_name, real_email FROM vss_users
QUERY
close DUMP;
}
if ($filename_file) {
open DUMP, '>', $filename_file;
print DUMP "$_->[0]\n"
for @{$dbh->selectall_arrayref(<<QUERY)};
SELECT canonical_name FROM file_names
QUERY
close DUMP;
}
}
###########################################################
# CHECKING OUT
sub find_items_by_path($%) {
my ($path, %flags) = @_;
my @items;
my $rmapping = $flags{-mappings} || \%vss_path_mapping;
while (my ($vsspath, $lpath) = each %$rmapping) {
#print "? $vsspath $lpath $path\n";
next unless defined $lpath
&& (matches($path, $lpath) || $lpath eq '/');
#print "? $vsspath $lpath $path\n";
my $tail = $lpath eq '/' ? '/'.$path : substr($path, length($lpath));
my $item = $vss->VSSItem(
'$'.$vsspath.$tail
) or next;
if ($flags{-physical}) {
next unless $item->{Physical} eq $flags{-physical};
}
push @items, $item;
}
if ($flags{-force_one}) {
(@items > 0) or
die "No VSS paths match for $path".
($flags{-physical} ?
" (physical $flags{-physical})" :
'').
"\n";
}
if ($flags{-force_one} || $flags{-force_noambig}) {
(@items < 2) or
die "Ambiguous match for $path: ".
join(', ', map { $_->[0]->{Spec} } @items).
"\n";
}
return @items;
}
sub check_conflicting_checkout($) {
my $item = shift;
my $costatus = $item->{IsCheckedOut};
if ($costatus && $costatus != VSSFILE_CHECKEDOUT_ME) {
my $couts = Win32::OLE::Enum->new($item->{Checkouts});
my @info;
while (defined (my $cout = $couts->Next())) {
push @info,
$cout->{Username}.
' on '.$cout->{Machine}.
' since '.$cout->{Date}->Date('yyyy-MM-dd');
}
die "File is already checked out to ".join(', ', @info).":\n $item->{Spec}\n";
}
}
sub get_last_version($) {
my ($item) = @_;
my $enum = Win32::OLE::Enum->new(
$item->Versions(VSSFLAG_HISTIGNOREFILES)
);
while (my $ver = $enum->Next()) {
return $ver unless $ver->{Action} =~ /^Label/;
}
return undef;
}
sub check_pinned_to_last($;$) {
my ($item, $new_ver) = @_;
if ($item->{IsPinned}) {
my $top_ver =
defined $new_ver ? $new_ver - 1 : get_last_version($item)->{VersionNumber};
if ($top_ver < $item->{VersionNumber}) {
print STDERR "File $item->{Spec} already pinned to $item->{VersionNumber}\n";
} elsif ($top_ver > $item->{VersionNumber}) {
my %commit_info;
$commit_info{$_->[0]} = [ $_->[1], $_->[2] ]
for @{$dbh->selectall_arrayref(<<QUERY)};
SELECT vss_version, commit_id, is_imported
FROM known_actions
WHERE vss_physid = @{[$dbh->quote($item->{Physical})]}
AND vss_version > $item->{VersionNumber}
AND vss_version <= $top_ver
QUERY
my @entries;
for (my $ver = $item->{VersionNumber}+1; $ver <= $top_ver; $ver++)
{
my $info = get_version_at $item, $ver;
push @entries,
$ver.': '.$info->{Username}.
' ('.$info->{Date}->Date('yyyy-MM-dd').') - '.($info->{Comment}||'no comment');
if ($commit_info{$ver}) {
$entries[-1] .= "\n commit $commit_info{$ver}[0]";
$entries[-1] .= ' (imported)' if $commit_info{$ver}[1];
}
}
die "File is pinned to version $item->{VersionNumber}, ".
"while the latest is $top_ver:\n $item->{Spec}\n".
join("\n", @entries)."\n";
}
}
}
sub check_within_mapping($$) {
my ($path, $mapping) = @_;
die "Master branch not specified for unpinned share $path\n"
unless $mapping;
my $lpath = lc $path;
$lpath =~ s/^\$//;
for my $testpath (keys %$mapping) {
return if matches($lpath, $testpath);
}
die "Unpinned share not within master branch: $path\n";
}
sub get_checkin_spec($$) {
my ($item, $mapping) = @_;
my @pinned;
my @unpinned;
my $links = Win32::OLE::Enum->new($item->{Links});
while (defined (my $link = $links->Next())) {
next if $link->{Deleted};
push @pinned, $link if $link->{IsPinned};
push @unpinned, $link if !$link->{IsPinned};
}
(@unpinned > 0) or
die "File has no unpinned shares:\n ".
join("\n ", map { $_->{Spec} } @pinned).
"\n";
(@unpinned < 2) or
die "File has multiple unpinned shares:\n ".
join("\n ", map { $_->{Spec} } @unpinned).
"\n";
check_within_mapping $unpinned[0]{Spec}, $mapping
if $item->{IsPinned};
return [ $unpinned[0], $item->{IsPinned} ? $item : undef ];
}
sub find_add_root($%) {
my ($path, %flags) = @_;
my @adds;
for(;;) {
my ($item) =
find_items_by_path $path,
-force_noambig => 1,
-mappings => $flags{-mappings};
return ($item, @adds) if $item;
$path =~ /^(?:(.+)\/)?([^\/]+)$/ or die "Bad path: $path";
unshift @adds, $2;
$path = $1||'';
}
}
sub spawn_project_tree($@) {
my ($root, @adds) = @_;
for my $pname (@adds) {
my $ci = $root->Child($pname);
$ci = $root->NewSubproject($pname, "") unless $ci;
$root = $ci;
}
return $root;
}
sub get_parent($) {
my $item = shift;
my $parent = $item->{Parent};
unless ($parent) {
$item->{Spec} =~ /^(.*)\/([^\/]+)/
or die "get_parent: invalid path $item->{Spec}\n";
my ($pp, $cn) = ($1, $2);
$parent = $vss->VSSItem($pp)
or die "get_parent: project $pp not found\n";
my $child = $parent->Child($cn);
$child && $child->{Physical} eq $item->{Physical}
or die "get_parent: child $cn of $pp not found or invalid.\n";
}
return $parent;
}
my %checkouts;
my %checkout_adds;
my $checked_out_now = 0;
my $checkin_merge_base;
my $checkin_comment;
sub check_out_file($$) {
my ($path, $master_map) = @_;
return if $checkout_adds{$path};
return if $checkouts{$path};
my ($item) = find_items_by_path $path, -force_one => 1;
check_conflicting_checkout $item;
check_pinned_to_last $item;
my $spec = get_checkin_spec $item, $master_map;
print CHECKOUT_LOG $branch_name,"\t",$spec->[0]{Spec},"\n";
unless ($spec->[0]{IsCheckedOut} == VSSFILE_CHECKEDOUT_ME) {
my $phys_path = $work_dir.'/'.$path;
$phys_path =~ s/\//\\/g;
print STDERR "Checking out $spec->[0]{Spec}\n";
$checked_out_now++;
$spec->[0]->Checkout("", $phys_path, VSSFLAG_FORCEDIRNO | VSSFLAG_GETNO);
die "Checkout of $spec->[0]{Spec} failed.\n"
unless $spec->[0]{IsCheckedOut} == VSSFILE_CHECKEDOUT_ME;
}
$checkouts{$path} = $spec;
}
sub check_out_add($$) {
my ($path, $master_map) = @_;
return if $checkout_adds{$path};
die "File checked out, cannot add: $path\n" if $checkouts{$path};
my ($root, @adds) = find_add_root $path, -mappings => $master_map;
die "File exists in the master branch, cannot add: $path\n" unless @adds;
my $share_spec;
if ($master_map) {
my ($root2, @adds2) = find_add_root $path;
die "File exists, cannot add: $path\n" unless @adds2;
$share_spec = [ $root2, \@adds2 ];
}
my $add_spec = join('/', $root->{Spec}, @adds);
print STDERR "Will add $add_spec\n";
print CHECKOUT_LOG $branch_name,"\t",$add_spec,"\n";
$checkout_adds{$path} = [ [ $root, \@adds ], $share_spec ];
}
sub exec_repin(\@\@\@;$) {
my ($rdellist, $rsharelist, $rpinlist, $ins_stmt) = @_;
for my $delitem (@$rdellist) {
my ($name, $item) = @$delitem;
next if $item->{Deleted};
print STDERR "Deleting $item->{Spec}\n";
my $parent = get_parent $item;
my $buddy = $parent->Child($item->{Name}, 1);
$buddy->Destroy() if $buddy;
$item->{Deleted} = 1;
if ($ins_stmt) {
my $pname = $name;
$pname =~ s/\/[^\/]*$//;
$ins_stmt->execute($parent->{Physical}, get_last_version($parent)->{VersionNumber}, 'Deleted', $pname);
}
}
for my $sharespec (@$rsharelist) {
my ($name, $parent, $adds, $fitem, $make_cout) = @$sharespec;
my $fname = pop @$adds;
$parent = spawn_project_tree $parent, @$adds;
my $new_ver = defined $make_cout ? $make_cout : 1;
print STDERR "Sharing to $parent->{Spec}/$fname at $new_ver\n";
my $fver = $fitem->Version($new_ver);
$parent->Share($fver, "", VSSFLAG_GETNO);
if (defined $make_cout) {
my $chld = $parent->Child($fname);
# Don't remove - if we don't query VersionNumber at this point, weird things happen
print STDERR " - shared at version $chld->{VersionNumber}\n"
unless $chld->{VersionNumber} == $new_ver;
delete $checkout_adds{$name};
$checkouts{$name} = [ $fitem, $chld ];
}
if ($ins_stmt) {
my $pname = $name;
$pname =~ s/\/[^\/]*$//;
$ins_stmt->execute($parent->{Physical}, get_last_version($parent)->{VersionNumber}, 'Shared', $pname);
}
}
for my $repin (@$rpinlist) {
my ($name, $item, $version) = @$repin;
if ($version <= $item->{VersionNumber}) {
print STDERR "Not repinning $item->{Spec} to $version - already $item->{VersionNumber}\n";
next;
}
print STDERR "Repinning $item->{Spec} to $version\n";
my $parent = get_parent $item;
my $ver0 = $item->Version(0);
my $verT = $item->Version($version);
my $pname = $name;
$pname =~ s/\/[^\/]*$// if $ins_stmt;
$parent->Share($ver0, "", VSSFLAG_GETNO);
$ins_stmt->execute($parent->{Physical}, get_last_version($parent)->{VersionNumber}, 'Shared', $pname) if $ins_stmt;
$parent->Share($verT, "", VSSFLAG_GETNO);
$ins_stmt->execute($parent->{Physical}, get_last_version($parent)->{VersionNumber}, 'Shared', $pname) if $ins_stmt;
}
}
my $checkin_tmpdir;
sub exec_checkin(\@\@\@$$) {
my ($rdels, $radds, $rcheckins, $msg, $ins_stmt) = @_;
my @pin_deletes;
my @pin_shares;
my @repins;
$checkin_tmpdir = tempdir(CLEANUP => 1)
unless $checkin_tmpdir;
for my $delspec (@$rdels) {
my ($name, $spec) = @$delspec;
my $parent = get_parent $spec->[0];
unless ($spec->[0]{Deleted}) {
print STDERR "Deleting $spec->[0]{Spec}\n";
my $buddy = $parent->Child($spec->[0]{Name}, 1);
$buddy->Destroy() if $buddy;
$spec->[0]{Deleted} = 1;
} else {
next unless $spec->[1];
}
if ($spec->[1]) {
push @pin_deletes, [ $name, $spec->[1] ];
} else {
my $pname = $name;
$pname =~ s/\/[^\/]*$//;
$ins_stmt->execute($parent->{Physical}, get_last_version($parent)->{VersionNumber}, 'Deleted', $pname);
}
}
for my $addspec (@$radds) {
my ($name, $spec, $blob) = @$addspec;
my ($parent, $adds) = @{$spec->[0]};
my $fname = pop @$adds;
$parent = spawn_project_tree $parent, @$adds;
print STDERR "Adding $parent->{Spec}/$fname\n";
my $tmp = $checkin_tmpdir."\\".$fname;
system "git-cat-file blob $blob > \"$tmp\"";
($? == 0 && -f $tmp) or die "Could not extract data";
my $cver = get_last_version($parent)->{VersionNumber};
my $fitem = $parent->Add($tmp, $msg,
VSSFLAG_FORCEDIRNO | VSSFLAG_DELNOREPLACE |
VSSFLAG_USERRONO | VSSFLAG_KEEPYES |
VSSFLAG_GETNO);
unlink $tmp;
my $nver = get_last_version($parent)->{VersionNumber};
unless ($nver > $cver) {
print STDERR " File not added: $nver <= $cver\n";
}
if ($spec->[1]) {
push @pin_shares, [ $name, $spec->[1][0], $spec->[1][1], $fitem, get_last_version($fitem)->{VersionNumber} ];
} else {
delete $checkout_adds{$name};
$checkouts{$name} = [ $fitem, undef ];
my $pname = $name;
$pname =~ s/\/[^\/]*$//;
$ins_stmt->execute($parent->{Physical}, $nver, 'Added', $pname)
unless $nver <= $cver;
}
}
for my $checkin (@$rcheckins) {
my ($name, $cout, $blob) = @$checkin;
print STDERR "Checking in $cout->[0]{Spec}\n";
my $tmp = $checkin_tmpdir."\\".$blob;
system "git-cat-file blob $blob > \"$tmp\"";
($? == 0 && -f $tmp) or die "Could not extract data";
my $cver = get_last_version($cout->[0])->{VersionNumber};
$cout->[0]->Checkin($msg, $tmp,
VSSFLAG_FORCEDIRNO | VSSFLAG_DELNOREPLACE |
VSSFLAG_USERRONO | VSSFLAG_KEEPYES |
VSSFLAG_GETNO);
unlink $tmp;
my $nver = get_last_version($cout->[0])->{VersionNumber};
if ($nver > $cver) {
if ($cout->[1]) {
push @repins, [ $name, $cout->[1], $nver ];
} else {
$ins_stmt->execute($cout->[0]{Physical}, $nver, 'Checked', $name);
}
} else {
print STDERR " File unchanged on check-in.\n";
}
}
exec_repin @pin_deletes, @pin_shares, @repins, $ins_stmt;
}
sub repin_commit($) {
my ($commit) = @_;
my ($old_branch, $imported) = $dbh->selectrow_array(<<QUERY);
SELECT branch_name, is_imported
FROM known_commits
WHERE commit_id = @{[$dbh->quote($commit)]}
QUERY
die "Unknown commit $commit\n"
unless $old_branch;
die "Cannot repin to the same branch.\n"
if $old_branch eq $branch_name;
my @checkins = @{$dbh->selectall_arrayref(<<QUERY)};
SELECT vss_physid, vss_version, vss_action, git_path
FROM known_actions
WHERE commit_id = @{[$dbh->quote($commit)]}
QUERY
die "No actions known for $commit\n" unless @checkins;
my $old_maps = load_other_mappings $old_branch;
my @dellist;
my @sharelist;
my @pinlist;
for my $row (@checkins) {
my ($physid, $version, $action, $path) = @$row;
if ($action =~ /Added|Deleted|Destroyed/) {
my ($old_prj) =
find_items_by_path $path,
-physical => $physid, -force_one => 1,
-mappings => $old_maps;
my $old_ver = get_version_at $old_prj, $version;
($old_ver->{Action} =~ /^(Added|Deleted|Destroyed|Recovered) (.*)$/
&& ($1 eq $action || ($1 eq 'Recovered' && $action eq 'Added')))
or die "Action mismatch: $old_ver->{Action} vs $action";
my $file = $2;
my $fpath = $path.'/'.$file;
if ($action eq 'Added') {
my $fitem = $old_ver->{VSSItem}->Child($file)
or die "Cannot get added file item";
my ($root, @adds) = find_add_root($fpath);
unless (@adds) {
$root->{Physical} eq $fitem->{Physical}
or die "Cannot add: file $fpath already exists\n";
print STDERR "File $root->{Spec} already added\n";
next;
}
push @sharelist, [ $fpath, $root, \@adds, $fitem ];
} else {
my ($item) = find_items_by_path $fpath, -force_one => 1;
check_pinned_to_last $item;
print "Warning: going to delete file $item->{Spec}\n";
push @dellist, [ $fpath, $item ];
}
} elsif ($action eq 'Checked') {
my ($item) = find_items_by_path $path, -physical => $physid, -force_one => 1;
next unless $item->{IsPinned};
check_pinned_to_last $item, $version;
push @pinlist, [ $path, $item, $version ];
} else {
die "Unsupported action in commit: $action";
}
}
exec_repin @dellist, @sharelist, @pinlist;
}
sub checkout_delta($$;$) {
my ($cur, $prev, $master_map) = @_;
my $rv = `git-diff --name-status $prev $cur`;
($? == 0) or die "Error comparing $prev and $cur.\n";
chomp $rv;
for my $row (split /\n/, $rv) {
my ($mode, $name) = split /\t/, $row;
eval {
if ($mode eq 'M') {
check_out_file $name, $master_map;
} elsif ($mode eq 'A') {
check_out_add $name, $master_map;
} else {
die "Unsupported change in diff $prev $cur: '$mode'\n"
}
};
if ($@) {
die $@ if $opt_commit;
print STDERR $@;
}
}
}
sub checkin_delta($%) {
my ($head, %flags) = @_;
return if $head eq $initial_head;
# Read the commit
my $data = `git-cat-file commit $head`;
my $hdr_end = index($data, "\n\n");
($hdr_end > 0) or die "Invalid commit $head\n";
# Validate history chains
my $refptr = index($data, "parent ".$initial_head."\n");
($refptr && $refptr < $hdr_end)
or die "Commit $head is not a child of the current head\n";
# Extract the comment
my $msg = substr($data, $hdr_end + 2);
$msg = $flags{-comment} if $flags{-comment};
# Determine the set of actions to perform
my $rv = `git-diff --raw --abbrev=40 $initial_head $head`;
($? == 0) or die "Error comparing $initial_head and $head.\n";
chomp $rv;
my @deletes;
my @checkins;
my @adds;
for my $row (split /\n/, $rv) {
$row =~ /^:(\d+) (\d+) ([a-f0-9]+) ([a-f0-9]+) ([AMD])\t(.*)$/
or die "Bad diff line: $row";
my ($oflags, $nflags, $oblob, $nblob, $mode, $name) = ($1, $2, $3, $4, $5, $6);
if ($mode eq 'M') {
my $cout = $checkouts{$name}
or die "File not checked out in check-in: $name\n";
push @checkins, [ $name, $cout, $nblob ];
} elsif ($mode eq 'A') {
my $cadds = $checkout_adds{$name}
or die "File not prepared for adding: $name\n";
push @adds, [ $name, $cadds, $nblob ];
} else {
die "Unsupported change in diff $initial_head $head: '$mode'\n"
}
}
# Log the actions into the db for future use
$dbh->prepare(
'INSERT INTO known_commits '.
'(commit_id, branch_name, parent_id, is_imported) '.
'VALUES (?, ?, ?, 0)'
)->execute(
$head, $branch_name, $initial_head
);
my $ins_stmt = $dbh->prepare(
'INSERT INTO known_actions '.
'(vss_physid, vss_version, vss_action, git_path, commit_id, is_imported) '.
'VALUES (?, ?, ?, ?, '.$dbh->quote($head).', 0)'
);
# Execute actions
exec_checkin @deletes, @adds, @checkins, $msg, $ins_stmt;
set_local_head $head;
}
sub checkout_changed_files() {
$checkin_merge_base = `git-merge-base vss/$branch_name HEAD`;
($? == 0) or die "Error finding merge base.\n";
chomp $checkin_merge_base;
my $rv = `git-rev-list --reverse --parents vss/$branch_name..HEAD`;
($? == 0) or die "Error retrieving revisions.\n";
chomp $rv;
my @commits = split /\n/, $rv;
unless (@commits) {
undef $opt_commit;
return;
}
my ($master_branch) = $dbh->selectrow_array(<<QUERY);
SELECT checkin_branch FROM vss_branches
WHERE branch_name = @{[$dbh->quote($branch_name)]}
QUERY
my $master_map = load_other_mappings ($opt_master || $master_branch);
open CHECKOUT_LOG, '>>', $checkout_file;
my %seen_comments = ('--none--' => 1);
my $prev = $checkin_merge_base;
for my $crow (@commits) {
my ($id, @parents) = split / /, $crow;
($opt_squash || (@parents == 1 && $parents[0] eq $prev))
or die "Nonlinear commit chain at $crow; use --squash to merge the branch instead.\n";
if ($opt_squash) {
my $data = `git-cat-file commit $id`;
my $msg = substr $data, index($data, "\n\n") + 2;
$checkin_comment .= $msg unless $seen_comments{$msg};
$seen_comments{$msg}++;
} else {
checkout_delta $id, $prev, $master_map;
}
$prev = $id;
}
checkout_delta $prev, $checkin_merge_base, $master_map if $opt_squash;
close CHECKOUT_LOG;
}
sub undo_all_checkouts(;$) {
my ($branch_filter) = @_;
my %vss_paths;
$vss_paths{$_->[0]} = $_->[1]
for @{$dbh->selectall_arrayref(<<QUERY)};
SELECT branch_name, repo_path FROM vss_branches
QUERY
my %cout_set;
my $log2_file = $checkout_file.'.new';
my ($log2);
unlink $log2_file;
open CHECKOUT_LOG, $checkout_file or return;
while (<CHECKOUT_LOG>) {
chomp;
my ($branch, $file) = split /\t/, $_;
if ($branch_filter && $branch ne $branch_filter) {
open $log2, '>', $log2_file
unless $log2;
print $log2 "$_\n";
next;
}
$cout_set{$vss_paths{$branch}}{$file}++;
}
close CHECKOUT_LOG;
print STDERR
"Undoing all checkouts",
($branch_filter ? " from $branch_filter" : ''),
".\n";
local $vss_path;
for $vss_path (keys %cout_set) {
open_vss_link();
for my $file (keys %{$cout_set{$vss_path}}) {
my $item = $vss->VSSItem($file) or next;
if ($item->{IsCheckedOut} == VSSFILE_CHECKEDOUT_ME) {
$item->UndoCheckout(undef,
VSSFLAG_FORCEDIRNO | VSSFLAG_REPSKIP |
VSSFLAG_DELNOREPLACE | VSSFLAG_GETNO |
VSSFLAG_USERRONO);
}
}
}
unlink $checkout_file;
if ($log2) {
close $log2;
rename $log2_file, $checkout_file;
}
}
###########################################################
# TOP-LEVEL PROCEDURES
sub verify_current_head() {
local $ENV{GIT_DIR} = $base_path;
my $head = `git rev-parse $branch_name`;
chomp $head;
die "Could not determine current branch head.\n" unless length($head) == 40;
if ($opt_newhead || $opt_init) {
$initial_head = $head;
} else {
die "Mismatch between DB head $initial_head and Git head $head\n"
if $head ne $initial_head;
}
}
sub fetch_branch_info() {
my $qname = $dbh->quote($branch_name);
my $upd_str = $is_postgres ? 'FOR UPDATE' : '';
($vss_path, $log_path, $log_offset, $initial_head) = $dbh->selectrow_array(<<QUERY)
SELECT repo_path, log_path, log_offset, current_head FROM vss_branches
WHERE branch_name = $qname
$upd_str
QUERY
or die "Unknown VSS branch $branch_name\n";
verify_current_head();
}
sub open_vss_link() {
$vss_path =~ s/[\\\/]$//;
# Connect to VSS
$vss = Win32::OLE->new('SourceSafe', 'Close')
or die "Could not start VSS\n";
$vss->Open($vss_path . "\\srcsafe.ini");
$vss_user = $vss->{Username}
or die "Could not connect to $vss_path\n";
}
sub is_unmerged() {
my $umf = `git-ls-files -u`;
return $umf =~ /\S/;
}
sub run_mergetool() {
if ($opt_mergetool && $opt_mergetool eq 'none') {
print "Merge conflicts and press enter:\n";
my $v = <STDIN>;
} elsif ($opt_mergetool) {
system $opt_mergetool;
($? == 0) or die "Merge tool invocation failed\n";
} else {
system 'git', 'mergetool';
($? == 0) or die "Merge tool invocation failed\n";
}
}
sub checkin_changes($) {
my ($pre) = @_;
die "Invalid context" if $ENV{GIT_INDEX_FILE};
my $comment;
if ($opt_squash) {
if ($opt_squash eq '-') {
open MSG_FILE, '<', $squash_msg_file
or die "Old squash comment not found\n";
local $/ = undef;
$comment = <MSG_FILE>;
close MSG_FILE;
} else {
$comment = $opt_squash;
$comment .= "\n\n".$checkin_comment
if $comment =~ /:$/;
open MSG_FILE, '>', $squash_msg_file;
print MSG_FILE $comment;
close MSG_FILE;
}
}
if ($opt_squash && !$pre) {
system 'git', 'merge', 'vss/'.$branch_name;
my $rc = $?>>8;
die "Fatal merge failure.\n" if ($rc >= 2);
if ($rc == 1) {
run_mergetool;
die "Unmerged files left\n" if is_unmerged;
system 'git', 'commit', '-F', $squash_msg_file;
($? == 0) or die "Commit failed\n";
}
my $new_head = `git-rev-parse HEAD`;
chomp $new_head;
return if $new_head eq $initial_head;
checkin_delta $new_head, -comment => $comment;
} else {
unless ($pre) {
system 'git', 'rebase', '--onto', $initial_head, $checkin_merge_base;
while ($? != 0) {
if (is_unmerged) {
run_mergetool;
die "Unmerged files left\n" if is_unmerged;
system 'git', 'rebase', '--continue';
next;
}
die "Fatal rebase failure\n";
}
}
my $new_head = `git-rev-parse HEAD`;
chomp $new_head;
if ($opt_squash) {
checkin_delta $new_head, -comment => $comment;
} else {
my $rv = `git-rev-list --reverse --parents $initial_head..$new_head`;
($? == 0) or die "Error retrieving revisions.\n";
chomp $rv;
my @commits = split /\n/, $rv;
for my $crow (@commits) {
my ($id, @parents) = split / /, $crow;
(@parents == 1 && $parents[0] eq $initial_head)
or die "Nonlinear commit chain '$crow'";
checkin_delta $id;
sleep 2;
}
}
}
}
sub update_branch_commits(%) {
my (%flags) = @_;
my $user_log_path = $log_path;
$log_path = $vss_path . "\\" . $log_path
unless $log_path =~ /^(?:[a-zA-Z]:)?[\\\/]/;
# Import initial checkout
if ($opt_import) {
print STDERR "Creating branch $branch_name...\n";
fetch_file_names();
create_initial_branch();
} else {
fetch_remote_head();
}
# Commit, if already checked out, and immediate fast forward
my $pre_commit =
$opt_commit && !$checked_out_now &&
$checkin_merge_base eq $initial_head;
checkin_changes(1) if $pre_commit;
# Import new changes
my $changed = $opt_nofetch ? 0 : fetch_data();
my $commit_error;
if ($opt_commit) {
eval {
checkin_changes(0) unless $pre_commit;
undo_all_checkouts($branch_name);
};
$commit_error = $@;
push_remote_head();
}
# Update the table
if ($opt_init || $opt_import) {
$dbh->prepare('DELETE FROM vss_branches WHERE branch_name = ?')
->execute($branch_name);
$dbh->prepare(<<QUERY)
INSERT INTO vss_branches (branch_name, repo_path, log_path, current_head, log_offset, checkin_branch)
VALUES (?, ?, ?, ?, ?, ?)
QUERY
->execute($branch_name, $vss_path, $user_log_path, $initial_head, $log_offset, $opt_master);
} elsif ($changed || $opt_newhead || $opt_commit) {
$dbh->prepare(<<QUERY)
UPDATE vss_branches
SET current_head = ?, log_offset = ?
WHERE branch_name = ?
QUERY
->execute($initial_head, $log_offset, $branch_name);
}
if ($commit_error) {
$dbh->do('COMMIT');
die $commit_error;
}
return $changed;
}
###########################################################
# MAIN CODE
# Connect to the db
if ($opt_init || $opt_import || $opt_load || $opt_dump) {
$base_path = `git config --get gitvss.basePath`;
if ($?) {
$base_path = '.';
system 'git-config', 'gitvss.basePath', '.';
} else {
chomp $base_path;
die "Init and import may only be done on the root repository.\n"
unless $base_path eq '.';
}
} elsif ($opt_connect) {
$base_path = shift @ARGV;
die "Bad base repository path: $base_path\n"
unless -f $base_path."/gitvss.sqlite"
|| -f $base_path."/gitvss.pg_ini";
system 'git-config', 'gitvss.basePath', $base_path;
} else {
$base_path = `git config --get gitvss.basePath`;
chomp $base_path;
die "Cannot determine the base repository path\n"
unless -f $base_path."/gitvss.sqlite"
|| -f $base_path."/gitvss.pg_ini";
}
if (-f $base_path."/gitvss.pg_ini") {
open INI, $base_path."/gitvss.pg_ini";
my ($params, @init_lines) = <INI>;
close INI;
chomp $params;
$is_postgres = 1;
$dbh = DBI->connect("dbi:Pg:$params","","", { RaiseError => 1 })
or die "Could not connect to the database.\n";
$dbh->do($_) for grep /\S/, @init_lines;
} else {
$dbh = DBI->connect("dbi:SQLite:dbname=$base_path/gitvss.sqlite","","", { RaiseError => 1 })
or die "Could not connect to the database.\n";
}
if ($opt_sanitize) {
sanitize_adds();
exit 0;
} elsif ($opt_connect) {
my @refspecs =
map { '+refs/heads/'.$_->[0].':refs/remotes/vss/'.$_->[0] }
@{$dbh->selectall_arrayref(<<QUERY)};
SELECT branch_name FROM vss_branches
QUERY
die "No branches found\n" unless @refspecs;
system 'git-fetch', $base_path, @refspecs;
($? == 0) or die "Could not fetch branches.\n";
exit 0;
} elsif ($opt_undo_checkouts) {
undo_all_checkouts($ARGV[0]);
exit 0;
}
$dbh->do($is_postgres ? 'BEGIN' : 'BEGIN IMMEDIATE TRANSACTION');
if ($opt_load) {
create_tables();
load_data();
$dbh->disconnect;
exit 0;
} elsif ($opt_dump) {
dump_data();
$dbh->disconnect;
exit 0;
}
# Determine which branch to update
if ($opt_init || $opt_import) {
create_tables();
$branch_name = shift @ARGV;
$vss_path = shift @ARGV;
$log_path = shift @ARGV;
$log_offset = shift @ARGV;
# Import path mappings
import_mappings unless $opt_nomaps;
# Compare current Git and database heads
verify_current_head unless $opt_import;
} else {
$branch_name = shift @ARGV;
unless ($branch_name) {
usage() if ($opt_rebase || $opt_repin);
$branch_name = `git config --get gitvss.defaultBranch`;
chomp $branch_name;
die "Cannot determine branch to fetch.\n" unless $branch_name;
}
fetch_branch_info();
}
open_vss_link();
load_mappings();
if ($opt_checkout || $opt_commit) {
checkout_changed_files();
} elsif ($opt_repin) {
for my $comspec (@ARGV) {
my $commit = `git-rev-parse --verify $comspec`;
($? == 0) or die "Invalid commit specified: $comspec\n";
chomp $commit;
print STDERR "Repinning $comspec...\n";
repin_commit $commit;
}
}
update_branch_commits();
# Done
$dbh->do('COMMIT');
$dbh->disconnect;
# Rebase
if ($opt_rebase && !$opt_commit) {
system 'git', 'rebase', 'vss/'.$branch_name;
}