Re: Yet another Perforce importer

Fixed another bug which could commit an empty tree. Improved error handling: the p4 program sends errors in the data stream, which were ignored. Now the scripts attempts to print them out.

---

@rem = 'NT: CMD.EXE vim: syntax=perl noet sw=4 @perl -x -s %0 -- %* @exit @rem '; #!perl -w #line 7

local $VERBOSE = 0; local $DRYRUN = 0; local $SHOW_DIFFS = 0; local $AUTO_COMMIT = 0; local $JUST_COMMIT = 0; local $P4CLIENT = undef; local @EDIT_COMMIT = 0; local @FULL_IMPORT = 0; local @DESC = (); local $SPEC = undef; local @P4ARGS = (); local $P4HAVE_FILE = undef; local %P4USERS = (); local $FULL_DESC = 1; local $HEAD_FROM_P4 = 0; local $P4_EDIT_CHANGED = 0; local $P4_EDIT_HEAD = undef;

push(@P4ARGS, '-P', $ENV{P4PASSWD})
    if defined($ENV{P4PASSWD}) and length($ENV{P4PASSWD});
use Cwd;
local $start_dir = cwd();

sub read_args {
    my ($in_client, $in_cl, $in_fi, $in_p4, $no_opt) = (0,0,0,0,0);
    foreach my $f ( @_ ) {
	goto _files if $no_opt;
	if ($in_client) { $in_client = 0; $P4CLIENT = $f; next }
	if ($in_cl) { $in_cl=0; push(@DESC,"c$f"); next }
	if ($in_fi) { $in_fi=0; push(@DESC,"f$f"); next }
	if ($in_p4) { $in_p4=0; push(@DESC,"4$f"); next }
	$no_opt=1, next if $f eq '--';
	$DRYRUN=1, next if $f eq '-n' or $f eq '--dry-run';
	$SHOW_DIFFS=$DRYRUN=1, next if $f eq '--diffs';
	$AUTO_COMMIT=1, next if $f eq '-y' or $f eq '--yes';
	$JUST_COMMIT=1, next if $f eq '--just-commit';
	$EDIT_COMMIT=1, next if ($f eq '-e') or ($f eq '--edit');
	$FULL_IMPORT=1, next if $f eq '--full';
	$FULL_DESC++, next if $f eq '--p4-desc';
	$P4_EDIT_CHANGED=1, next if $f eq '--p4-edit-changed';
	if ($f =~ /^--p4-edit-changed=(.*)/) {
	    $P4_EDIT_CHANGED=1;
	    $P4_EDIT_HEAD=$1;
	    next
	}
	$VERBOSE++, next if $f eq '-v' or $f eq '--verbose';
	$in_client = 1, next if $f eq '--client';
	$P4CLIENT = $1, next if $f =~ /^--client=(.*)/;
	$in_cl = 1, next if $f eq '-C';
	push(@DESC,"c$1"), next if $f =~ /^--changelist=(.*)/;
	$in_fi = 1, next if $f eq '-F';
	push(@DESC,"f$1"), next if $f =~ /^--file=(.*)/;
	$in_p4 = 1, next if ($f eq '--ptr') or ($f eq '--p4');
	push(@DESC,"4$2"), next if $f =~ /^--(p4|ptr)=(.*)/;

	if ($f eq '--help' or $f eq '-h') {
	    print <<EOF;
$0 [-n|--dry-run] [-y|--yes] [--client <client-name>] [--diffs] \
[-e|--edit] [--just-commit] [--full] [-v|--verbose] [-C <change-number>] \
[-F <filename>] [--ptr|--p4 <p4-path-and/or-revision>] [--p4-desc] \
[--] [<specification>]

Perforce client state importer. Creates a git commit on the current branch from a state the given p4 client and working directory hold.

<specification> must be given and is expected to be a file which will be stored on the side branch under the name "spec". Remote-to-local mapping and the revisions of files are stored in "have", and the client definition - in "client".

--client client Specify client name (saved in .git/p4/client for the next time) --full Perform full import, don't even try to figure out what changed -y|--yes Commit automatically (by default only index updated) --just-commit To be used after you forgot to run with --yes first time -n|--dry-run Do not update the index and do not commit -e|--edit Edit commit description before committing -v|--verbose Be more verbose. Can be given many times, increases verbosity

--file=file
-F file         Take description for the commit from a file in the
                next parameter

--changelist=change -C change Take description for the commit from this p4 change

--p4|--ptr p4-path-and/or-revision
--p4|--ptr=p4-path-and/or-revision
                Take description for the commit from the p4 change described
                by this p4 path, possibly including revision specification

--p4-desc       Increase amount of junk from p4 change description

--diffs         Show files which are different between local filesystem, index,
                and the current HEAD. Does not do anything else

--p4-edit-changed
--p4-edit-changed=sha1
                Merge with the given sha1 and prepare a p4 submission.
                Current HEAD must fast-forward to sha1. If sha1 is omited,
                the current HEAD is assumed. The working directory must
                have no local changes.

The descriptions taken from p4 changes given by -C and --p4 will be concatenated if the options given multiple times. "--" can be used to separate options from description files.

EOF
	    exit(0);
	}
	die "$0: unknown option $f\n" if $f =~ /^-/;
    _files:
	warn "$0: spec was already set, $SPEC ignored\n" if defined($SPEC);
	$SPEC = $f;
    }
}
read_args(@ARGV);

local ($GIT_DIR) = qx{git rev-parse --git-dir}; $GIT_DIR =~ s/\r?\n$//s if defined($GIT_DIR); die "$0: git directory not found\n" if !defined($GIT_DIR) or !-d $GIT_DIR;

local $editor = $ENV{VISUAL}; $editor = $ENV{EDITOR} unless defined($editor); $editor = 'd:/Programs/Vim/vim70/gvim.exe' unless defined($editor); die "$0: no editor defined\n" unless defined($editor);

if ($SHOW_DIFFS) {
    my $sep = $/;
    $/="\0";
    my ($show, $cnt) = (0, 0);
    if (open(F, '-|', 'git diff-files -r --name-only -z')) {
	while (<F>) {
	    my $c = chop;
	    $_ .= $c if $c ne "\0";
	    print "Changed files:\n" if !$show;
	    print " $_\n";
	    $show = 1;
	    $cnt++;
	}
	close(F);
    }
    if (open(F, '-|', 'git diff-index --cached -r -z HEAD')) {
	$show = 0;
	my ($diff, $info) = (0, 1);
	while (<F>) {
	    my $c = chop;
	    $_ .= $c if $c ne "\0";
	    if ($info) {
		next if !/^:(\d{6}) (\d{6}) ([0-9a-f]{40}) ([0-9a-f]{40}) ./o;
		# show only content changes, p4 does not support exec-bit anyway
		$diff = $3 ne $4;
	    } elsif ($diff) {
		print "Changes between index and HEAD:\n" if !$show;
		print " $_\n";
		$show = 1;
		$cnt++;
	    }
	    $info = !$info;
	}
	close(F);
    }
    $/ = $sep;
    exit($cnt ? 1: 0);
}

# P4 client was given in command-line. Store it
if ( defined($P4CLIENT) ) {
    mkdir "$GIT_DIR/p4", 0777;
    if ( open(F, '>', "$GIT_DIR/p4/client") ) {
	print F "$P4CLIENT\n";
	close(F);
    } else {
	die "$0: cannot store client name: $!\n"
    }
} else {
    if ( open(F, '<', "$GIT_DIR/p4/client") ) {
	($P4CLIENT) = <F>;
	close(F);
	$P4CLIENT =~ s/^\s*//,$P4CLIENT =~ s/\s*$// if defined($P4CLIENT);
    }
}
die "P4 client not defined\n" if !defined($P4CLIENT) or !length($P4CLIENT);
print "reading P4 client $P4CLIENT\n" if $VERBOSE;
local ($P4ROOT, $p4clnt, $P4HOST);
open(my $fdo, '>', "$GIT_DIR/p4/client.def") or die "p4/client.def: $!\n";
binmode($fdo);
open(my $fdi, '-|', "p4 client -o $P4CLIENT") or die "p4 client: $!\n";
binmode($fdi);
my $last_line_len = 0;
while (<$fdi>) {
    next if /^#/o;
    if ( m/^\s*Root:\s*(\S+)[\\\/]*\s*$/so ) { $P4ROOT = $1 }
    elsif ( m/^\s*Client:\s*(\S+)/o ) { $p4clnt = $1 }
    elsif ( m/^\s*Host:\s*(\S+)/o ) { $P4HOST = $1 }
    ($VERBOSE and print), next if /^(Access|Update):/;
    s/\r?\n$//so;
    my $len = length($_);
    print $fdo "$_\n" if $len or $len != $last_line_len;
    $last_line_len = $len;
}
close($fdi);
close($fdo);

die "Client root not defined\n" unless defined($P4ROOT);
if ( $VERBOSE ) {
    print "GIT_DIR: $GIT_DIR\n";
    print "Root: $P4ROOT (cwd: $start_dir)\n";
    print "Host: $P4HOST\n";
    print "Client: $p4clnt\n" if $p4clnt ne $P4CLIENT;
}

if ($P4_EDIT_CHANGED) {
    my $rc = system('git', 'diff-files', '--quiet');
    exit(127) if $rc & 0xff; # error starting the program
    die "$0: there are changes in $P4ROOT. Import them first.\n" if $rc;
    $P4_EDIT_HEAD = 'HEAD' if !defined($P4_EDIT_HEAD);
    my ($mergehead) = qx{git rev-parse $P4_EDIT_HEAD};
    exit(127) if $?;
    exit(1) if !defined($mergehead);
    $mergehead =~ s/\r?\n//gs;
    exit(1) if !length($mergehead);
    print "Checking out $P4_EDIT_HEAD ($mergehead) for p4 edit\n" if $VERBOSE;
    # Check if the give reference is a direct descendant of current branch
    if ($P4_EDIT_HEAD ne 'HEAD') {
	my ($sha1) = qx{git rev-list --max-count=1 $mergehead..HEAD};
	exit(127) if $?;
	die "$0: HEAD does not fast-forward to $P4_EDIT_HEAD\n"
	    if defined($sha1) and $sha1 =~ /^[0-9a-f]{40}\b/;
    }
    my $cnt;
    my @files = ();
    my $sep = $/;
    $/="\0";
    if (open(F, '-|', "git diff-index -R --cached -r -z $mergehead")) {
	my ($diff, $info, $M) = (0, 1, '');
	while (<F>) {
	    my $c = chop;
	    $_ .= $c if $c ne "\0";
	    if ($info) {
		next if !/^:\d{6} \d{6} ([0-9a-f]{40}) ([0-9a-f]{40}) (\w+)/o;
		# use only content changes, p4 does not support exec-bit
		$diff = $1 ne $2;
		$M = $3; # change type marker
	    } elsif ($diff) {
		print "$M $_\n" if $VERBOSE;
		die "File contains characters which p4 cannot support\n"
		    if /[\n@#%*]/s;
		push @files, "$M$_";
		$cnt++;
	    }
	    $info = !$info;
	}
	close(F);
    }
    $/ = $sep;
    if (!$cnt) {
	warn "$0: No content changes found between HEAD and $P4_EDIT_HEAD";
	exit(0);
    }
    # Create a new changelist
    my $p4;
    open($p4, "p4 -c $P4CLIENT -H $P4HOST -d $P4ROOT change -o|") or
	die "$0: failed to create changelist\n";
    my @desc = map {s/\r?\n//so; $_} <$p4>;
    close($p4);
    open($p4, '>', "$GIT_DIR/p4/changelist") or
	die "$GIT_DIR/p4/changelist: $!\n";
    foreach (@desc) {
	print $p4 "$_\n";
	if (/^Description:/o) {
	    my $range = "..$mergehead";
	    $range = "${mergehead}^..$mergehead" if $P4_EDIT_HEAD eq 'HEAD';
	    if (open(my $fd, '-|', "git log $range")) {
		while(<$fd>) {
		    # I believe it is not possible to save this information
		    # in Perforce.
		    next if /^(commit |Author:|Date:)/;
		    s/\r?\n$//so;
		    next if !length($_);
		    s/^\s+//o;
		    print $p4 " $_\n";
		}
		close($fd);
	    }
	}
    }
    close($p4);
    open(STDIN, '<', "$GIT_DIR/p4/changelist") or
	die "$GIT_DIR/p4/changelist: $!\n";
    open($p4, "p4 -c $P4CLIENT -H $P4HOST -d $P4ROOT change -i|") or
	die "$0: failed to create changelist\n";
    my ($newchange) = grep {s/^Change (\d+) created\b.*/$1/so} <$p4>;
    close($p4);
    print "Checking out P4 files in changelist $newchange\n" if $VERBOSE;
    # open files for edit
    $cnt = 0;
    open($p4, '>', "$GIT_DIR/p4/files") or die "$GIT_DIR/p4/files: $!\n";
    print $p4 "-c\n$newchange\n";
    print $p4 (map {++$cnt; substr($_,1)."\n"} grep {/^M/} @files);
    close($p4);
    sub runp4 {
	return system('p4','-c',$P4CLIENT,'-H',$P4HOST,'-d',$P4ROOT,@_);
    }
    runp4('-x',"$GIT_DIR/p4/files", 'edit') if $cnt;

    $cnt = 0;
    open($p4, '>', "$GIT_DIR/p4/files") or die "$GIT_DIR/p4/files: $!\n";
    print $p4 "-c\n$newchange\n";
    print $p4 (map {++$cnt; substr($_,1)."\n"} grep {/^A/} @files);
    close($p4);
    runp4('-x',"$GIT_DIR/p4/files", 'add') if $cnt;

    $cnt = 0;
    open($p4, '>', "$GIT_DIR/p4/files") or die "$GIT_DIR/p4/files: $!\n";
    print $p4 "-c\n$newchange\n";
    print $p4 (map {++$cnt; substr($_,1)."\n"} grep {/^D/} @files);
    close($p4);
    runp4('-x',"$GIT_DIR/p4/files", 'delete') if $cnt;

    # p4 modifies working directory on checkout, stupid thing
    system('git', 'update-index', '--refresh');
    $rc = system('git', 'read-tree', '-m', '-u', $mergehead);
    exit(127) if $rc & 0xff;
    exit(1) if $rc;
    print "The state of $P4_EDIT_HEAD($mergehead) is checked out.\n";
    print "A p4 changelist $newchange is prepared.\n";
    exit(0);
}

my ($git_head,$git_p4_head,$git_p4_have) = &git_p4_init;

if ($JUST_COMMIT) {
    git_p4_commit($git_head, $git_p4_head);
    exit 0;
}

local %gitignore_dirs = (); $gitignore_dirs{'/'} = read_filter_file("$GIT_DIR/info/exclude"); push(@{$gitignore_dirs{'/'}}, @{read_filter_file('.gitignore')});

my %git_index = ();
$/ = "\0";
my @git_X = ();
print "Reading git file list(git ls-files @git_X --cached -z)...\n" if $VERBOSE;
foreach ( qx{git ls-files @git_X --cached -z} ) {
    chop; # chop \0
    next if m/^\.gitignore$/o;
    next if m/\/\.gitignore$/o;
    next if filtered($_);
    $git_index{$_} = 1;
}

my @git_add = (); my @git_addx = (); my @git_del = (); my @git_upd = ();

print "Reading P4 file list...\n" if $VERBOSE;
local ($Conflicts,$Ignored,$Added,$Deleted,$Updated) = (0,0,0,0,0);
$/ = "\n";
my $in_name = 0;
my @root = split(/[\/\\]+/, $P4ROOT);
my %p4_index = ();
my %p4_a_lc = ();
my %lnames = ();
my %lconflicts = ();
if (opendir(DIR, '.')) {
    $lnames{'.'} = [grep {$_ ne '.' and $_ ne '..'} readdir(DIR)];
    closedir(DIR);
    #print "read $start_dir (",scalar(@{$lnames{'.'}}),")\n";
}
open(my $have, "p4 -G @P4ARGS -c $P4CLIENT -H $P4HOST -d $P4ROOT have |") or
    die "$0: failed to start p4: $!\n";
binmode($have);
$P4HAVE_FILE = "$GIT_DIR/p4/have";
open(my $storedhave, '>', $P4HAVE_FILE) or die "$P4HAVE_FILE: $!\n";
binmode($storedhave);
my ($cnt,$err,$ent) = (0,0,undef);
while (defined($ent=read_pydict_entry($have))) {
    if (defined($ent->{code}) and defined($ent->{data})) {
	++$err if $ent->{code} eq 'error';
	print STDERR 'p4: '.$ent->{code}.': '.$ent->{data}."\n";
	next;
    }
    next if !defined($ent->{depotFile}) or !defined($ent->{clientFile});
    ++$cnt;
    my $a = $ent->{depotFile};
    $ent->{clientFile} =~ m!^//[^/]+/(.*)!o;
    my $b = $1;
    my @bb = split(/\/+/, $b);
    print $storedhave "$a\0$ent->{clientFile}\0$ent->{haveRev}\0\n";

    if ( $^O eq 'MSWin32' ) {
	# stupid windows, daft activestate, dumb P4
	# This piece below is checking for file name conflicts
	# which happen on windows because of it mangling the names.
	my $blc = lc $b;
	if ( $#bb > 0 ) {
	    my $path = '.';
	    foreach my $n (@bb[0 .. $#bb -1]) {
		my @conflicts =
		    grep {lc $_ eq lc $n and $_ ne $n} @{$lnames{$path}};
		if (@conflicts and !exists($lconflicts{"$path/$n"})) {
		    warn "warning: $a -> $b\n".
			 "warning: conflict between path \"$path/$n\" and ".
			 "local filesystem in \"@conflicts\"\n";
		    $Conflicts++;
		    $lconflicts{"$path/$n"} = 1;
		}
		$path .= "/$n";
		if (!exists($lnames{$path})) {
		    if (opendir(DIR, $path)) {
			$lnames{$path} =
			    [grep {$_ ne '.' and $_ ne '..'} readdir(DIR)];
			closedir(DIR);
			#print "read $path (",scalar(@{$lnames{$path}}),")\n";
		    }
		}
	    }
	}
	if (!exists($p4_a_lc{$blc})) {
	    $p4_a_lc{$blc} = [$a, $b];
	} else {
	    warn("warning: $a -> $b\n".
		 "warning: conflicts with ".
		 $p4_a_lc{$blc}->[0]." -> ".
		 $p4_a_lc{$blc}->[1]."\n");
	    $Conflicts++;
	    next;
	}
    }

    my $i;
    for ($i = 0; $i < $#bb; ++$i) {
	my $bdir = join('/',@bb[0 .. $i]) . '/';
	if ( !exists($gitignore_dirs{$bdir}) ) {
	    $gitignore_dirs{$bdir} = read_filter_file("$bdir.gitignore");
	}
    }
    if (filtered($b)) {
	print " i $b\n" if $VERBOSE > 3;
	$Ignored++;
	next
    }
    $p4_index{$b} = $a;
    if ( exists($git_index{$b}) ) {
	my $needup = 1;
	if (defined($git_p4_have)) {
	    $prev = $git_p4_have->{$a};
	    if (defined($prev)) {
		$prev->[0] =~ m!^//[^/]+/(.*)!o;
		$needup = 0 if ($b eq $1) and ($prev->[1] eq $ent->{haveRev});
		if ($needup and $VERBOSE > 1) {
		    my $reason;
		    $reason = 'local file' if $b ne $1;
		    $reason = 'revision' if $prev->[1] ne $ent->{haveRev};
		    print "$a ($reason changed)\n";
		}
	    }
	}
	if ($needup) {
	    $Updated++;
	    push(@git_upd, $b);
	}
    } else {
	$Added++;
	if ( $b =~ m/\.(bat|cmd|pl|sh|exe|dll)$/io )
	{ push(@git_addx, $b) } else { push(@git_add, $b) }
    }
}
close($storedhave);
close($have);
exit 1 if $err; # the error already reported
die "Nothing in the client $P4CLIENT\n" if !$cnt;

undef %p4_a_lc;

@git_del = grep { !exists($p4_index{$_}) } keys %git_index; $Deleted = $#git_del + 1;

#foreach (keys %git_index) #{ push(@git_del, $_) if !exists($p4_index{$_}) }

if ( $DRYRUN ) {
    print($#git_add+$#git_addx+ 2," files to add\n") if $VERBOSE;
    print map {" a $_\n"} @git_add if $VERBOSE > 2;
    print map {" a $_\n"} @git_addx if $VERBOSE > 2;
    print($#git_del+1," files to unreg\n") if $VERBOSE;
    print map {" d $_\n"} @git_del if $VERBOSE > 2;
    print($#git_upd+1," files to update\n") if $VERBOSE;
    print map {" u $_\n"} @git_upd if $VERBOSE > 2;
    print "added: $Added, unregd: $Deleted, updated: $Updated,
ignored: $Ignored";
    print ", conflicts: $Conflicts" if $Conflicts;
    print "\n";
} else {
    if (@git_add || @git_addx) {
	print($#git_add+$#git_addx+ 2,
	      " files | git update-index --add -z --stdin\n")
	    if $VERBOSE;
	if (@git_add) {
	    open(GIT, '| git update-index --add --chmod=-x -z --stdin') or
		die "$0 git-update-index(add): $!\n";
	    print GIT map {print " a $_\n" if $VERBOSE > 1; "$_\0"} @git_add;
	    close(GIT);
	}
	if (@git_addx) {
	    open(GIT, '| git update-index --add --chmod=+x -z --stdin') or
		die "$0 git-update-index(add): $!\n";
	    print GIT map {print " a $_\n" if $VERBOSE > 1; "$_\0"} @git_addx;
	    close(GIT);
	}
    }

    if (@git_del) {
	print($#git_del+1," files | git update-index --remove -z --stdin\n")
	    if $VERBOSE;
	open(GIT, '| git update-index --force-remove -z --stdin') or
	    die "$0 git-update-index(del): $!\n";
	print GIT map {print " d $_\n" if $VERBOSE > 1; "$_\0"} @git_del;
	close(GIT);
    }

    if (@git_upd) {
	print($#git_upd+1," files | git update-index -z --stdin\n")
	    if $VERBOSE;
	open(GIT, '| git update-index -z --stdin') or
	    die "$0 git-update-index(upd): $!\n";
	print GIT map {print " u $_\n" if $VERBOSE > 1; "$_\0"} @git_upd;
	close(GIT);
    }

    print "added: $Added, unregd: $Deleted, updated: $Updated,
ignored: $Ignored";
    print ", conflicts: $Conflicts" if $Conflicts;
    print "\n";
    git_p4_commit($git_head, $git_p4_head) if $AUTO_COMMIT;
}

exit 0;

sub filtered {
    my $name = shift;
    study($name);
    my @path = split(/\/+/o, $name);
    my $dir = '';
    $name = '';

    foreach my $d (@path) {
	$name .= $d;
#	print STDERR "$dir: $name $d\n" if $v;
	foreach my $re (@{$gitignore_dirs{'/'}}) {
	    return 1 if $name =~ m/$re/;
	    return 1 if $d =~ m/$re/;
	}
	if ( length($dir) and exists($gitignore_dirs{$dir}) ) {
	    foreach my $re (@{$gitignore_dirs{$dir}}) {
		return 1 if $name =~ m/$re/;
		return 1 if $d =~ m/$re/;
	    }
	}
	$name .= '/';
	$dir = $name;
    }
#    print STDERR "$name not filtered\n" if $v;
    return 0;
}

sub read_filter_file {
    my @filts = ();
    my $file = shift;
    if ( open(my $if, '<', $file) ) {
	print "added ignore file $file\n" if $VERBOSE;
	$/ = "\n";
	while (my $l = <$if>) {
	    next if $l =~ /^\s*#/o;
	    next if $l =~ /^\s*$/o;
	    $l =~ s/[\r\n]+$//so;
	    $l =~ s/\./\\./go;
	    $l =~ s/\*/.*/go;
	    if ( $l =~ m/\// ) {
		$l = "^$l($|/)";
	    } else {
		$l = "(^|/)$l\$";
	    }
	    print " filter $l\n" if $VERBOSE > 1;
	    push(@filts, qr/$l/);
	}
	close($if);
    }
    return \@filts;
}

sub r_pystr
{
    my $fd = shift;
    my ($len,$str)=('','');
    my ($c,$rd,$b) = (4,0,'');
    while ($c > 0) {
	$rd = sysread($fd,$b,$c);
	warn("failed to read len: $!"), return undef if !defined($rd);
	warn("not enough data for len"), return undef if !$rd;
	$len .= $b;
	$c -= $rd;
    }
    $len = unpack('V',$len);
    while ($len > 0) {
	$rd = sysread($fd,$b,$len);
	warn("failed to read data: $!"), return undef if !defined($rd);
	warn("not enough data"), return undef if !$rd;
	$str .= $b;
	$len -= $rd;
    }
    return $str;
}

sub read_pydict_entry
{
    my $f = shift;
    my ($buf,$rd);
    FIL: while (1) {
	# object type identifier
	$rd = sysread($f, $buf, 1);
	last FIL if $rd == 0;
	warn("p4: object type: $!\n"),last if $rd != 1;
	# '{' is a python marshalled dict
	warn("p4: object type: not {\n"),last if $buf ne '{';
	my $ent = {};
	PAIR: while (1) {
	    my ($b,$key);
	    # key type identifier
	    $rd = sysread($f, $b, 1);
	    warn("p4: key type: $!\n"),last FIL if $rd != 1;
	    if ($b eq 's') { # length-prefixed string
		$key = r_pystr($f);
		warn("p4: key: $!\n"),last FIL if !defined($b);
	    } elsif ($b eq '0') { # NULL-element, end of entry
		last PAIR;
	    } else {
		die("p4: key type: not s (string)\n");
		last FIL;
	    }
	    # value type identifier
	    $rd = sysread($f, $b, 1);
	    warn("p4: $key value type: $!\n"),last FIL if $rd != 1;
	    if ($b eq 's') { # length-prefixed string
		$b = r_pystr($f);
		warn("p4: $key value: $!\n"),last FIL if !defined($b);
		$ent->{$key} = $b;
	    } elsif ($b eq 'i') { # 4-byte integer
		$rd = sysread($f, $b, 4);
		warn("p4: $key value data: $!\n"),last FIL if $rd != 4;
		$ent->{$key} = $b;
	    } else {
		warn("p4: $key value type: not s ($b)\n");
		last FIL;
	    }
	}
	return $ent;
    }
    return undef;
}

sub cl2msg {
    my $cl = shift;
    my($o1,$o2,$i);
    if(!open($o1, '>>', "$GIT_DIR/p4/msg")) {
	warn "p4/msg: $!\n";
	return;
    }
    binmode($o1);
    if(!open($o2, '>>', "$GIT_DIR/p4/p4msg")) {
	warn "p4/p4msg: $!\n";
	close($o1);
	return
    }
    binmode($o2);
    if(!open($i, '-|', "p4 describe -s $cl")){
	warn "p4 describe: $!\n";
	close($o1);
	close($o2);
	return
    }
    binmode($i);
    print $o1 "$cl: " if $FULL_DESC;
    print $o2 "$cl: ";
    my @a;
    my $u = undef;
    while (my $l = <$i>) {
	if ($l =~ /^Change \d+ by (\S+)@[^ ]* on ([^\r\n]*)/so) {
	    $u = $1;
	    $ENV{GIT_AUTHOR_DATE} = $2 if length($2);
	}
	last if $FULL_DESC < 2 and $l =~ /^\s*Affected files \.{3}\s*$/so;
	$l =~ s/\r?\n$//so;
	push @a, $l;
    }
    close($i);
    print $o2 substr($a[2],1),"\n"; # p4 side-branch commit description
    close($o2);
    # import branch commit description
    if ($FULL_DESC > 1) {
	# desc level 2+: keep the Change line
	print $o1 map {"$_\n"} (substr($a[2],1),"\n",@a);
    } else {
	# levels 0 and 1: remove the Change line
	print $o1 map { (length($_) ? substr($_,1):'')."\n" } @a[2..$#a];
    }
    close($o1);
    if (defined($u)) {
	if (!exists($P4USERS{$u})) {
	    my ($mail,$name) = grep {/^(Email|FullName):/} qx{p4 user -o $u};
	    if ($? == 0 and defined($mail) and defined($name)) {
		s/^\S+:	([^\r\n]*)\r?\n$/$1/so for ($mail,$name);
		if (length($name) and length($mail)) {
		    $P4USERS{$u} = {name=>$name, email=>$mail};
		}
	    }
	}
	if ($P4USERS{$u}) {
	    $p4u = $P4USERS{$u};
	    $ENV{GIT_AUTHOR_NAME}  = $p4u->{name};
	    $ENV{GIT_AUTHOR_EMAIL} = $p4u->{email};
	}
    }
}

sub git_p4_init {
    my ($commit,$parent,$p4commit,$p4parent);
    my ($HEAD) = qx{git rev-parse HEAD};
    $HEAD = '' if $?;
    my ($p4head) = qx{git rev-parse refs/p4import/$P4CLIENT};
    $p4head = '' if $?;
    s/\r?\n//gs for ($HEAD, $p4head);
    die "No HEAD commit! Refusing to import.\n" if !length($HEAD);
    if (length($p4head)) {
	($commit,$p4parent) =
	    grep { s/^parent (.{40}).*/$1/s }
	    qx{git cat-file commit $p4head};
	$commit = $p4parent = '' if $?;
	$p4parent = '' if !defined($p4parent);
    } else {
	$commit = $p4parent = '';
    }
    while (($commit ne $HEAD) and length($p4parent)) {
	$p4head = $p4parent;
	($commit,$p4parent) =
	    grep { s/^parent (.{40}).*/$1/s }
	    qx{git cat-file commit $p4head};
	$commit = $p4parent = '' if $?;
	$p4parent = '' if !defined($p4parent);
	if ($VERBOSE and ($HEAD eq $commit)) {
	    print "found p4 import commit ";
	    system('git','name-rev',$p4head);
	}
    }
    if ($HEAD ne $commit) {
	$HEAD_FROM_P4 = 0;
	warn "Current HEAD is not from $P4CLIENT, doing full import\n";
    } else {
	$HEAD_FROM_P4 = 1;
    }
    my $p4have = undef;
    if (!$FULL_IMPORT and ($HEAD eq $commit) and length($p4head)) {
	if (open(my $f, '-|', "git cat-file blob $p4head:have")) {
	    my $old = $/;
	    $/ = "\0";
	    my $cnt = 0;
	    while(1) {
		my $p4name = <$f>;
		last if !defined($p4name);
		$p4name =~ s/^.//so if $cnt; # remove \n
		my $name = <$f>;
		my $rev = <$f>;
		last if !defined($name) or !defined($rev);
		chop($p4name,$name,$rev);
		++$cnt;
		if (defined($p4have)) {
		    $p4have->{$p4name} = [$name,$rev];
		} else {
		    $p4have = {$p4name=>[$name,$rev]};
		}
	    }
	    $/ = $old;
	    close($f);
	    print "loaded $cnt revisions from $p4head\n" if $VERBOSE;
	}
    }
    return ($HEAD, $p4head, $p4have);
}

sub git_p4_commit {
    my ($HEAD, $p4head) = @_;
    my ($commit,$parent,$p4commit,$p4parent);

    my ($fdo,$fdi,$rc);
    $rc = system('git','diff-index','--exit-code','--quiet','--cached','HEAD');
    if ($rc == 0) {
	warn("No changes\n");
	return;
    }

    return if $DRYRUN;

    if (!@DESC && !$EDIT_COMMIT) {
	warn "$0: no commit description given\n";
	return;
    }

    my $p4x = "$GIT_DIR/p4/idx.tmp";
    unlink($p4x);

    $ENV{PAGER} = 'cat';

    if (!defined($SPEC) or !open(STDIN, '<', $SPEC)) {
	if ( $^O eq 'MSWin32' ) {
	    open(STDIN, '<', 'NUL') or die "$SPEC: $!\n";
	} else {
	    open(STDIN, '<', '/dev/null') or die "$SPEC: $!\n";
	}
    }
    my ($p4spec) = qx{git hash-object -t blob -w --stdin};
    die "Failed to store $SPEC in git repo\n" if $?;

    open(STDIN, '<', "$GIT_DIR/p4/client.def") or die "cldef: $!\n";
    my ($p4clnt) = qx{git hash-object -t blob -w --stdin};
    die "Failed to save mappings of $P4CLIENT in git repo" if $?;

    if (!defined($P4HAVE_FILE)) {
	print "reading state of $P4CLIENT\n" if $VERBOSE;
	$P4HAVE_FILE = "$GIT_DIR/p4/have";
	open($fdo, '>', $P4HAVE_FILE) or die "p4/have: $!\n";
	binmode($fdo);
	open($fdi, "p4 -G @P4ARGS -c $P4CLIENT -H $P4HOST -d $P4ROOT have|") or
	    die "p4 have: $!\n";
	binmode($fdi);
	my ($cnt,$err,$ent) = (0,0,undef);
	while (defined($ent=read_pydict_entry($fdi))) {
	    if (defined($ent->{code}) and defined($ent->{data})) {
		++$err if $ent->{code} eq 'error';
		print STDERR 'p4: '.$ent->{code}.': '.$ent->{data}."\n";
		next;
	    }
	    next if !defined($ent->{depotFile});
	    next if !defined($ent->{clientFile});
	    ++$cnt;
	    print $fdo "$ent->{depotFile}\0",
		       "$ent->{clientFile}\0",
		       "$ent->{haveRev}\0\n";
	}
	close($fdi);
	close($fdo);
	exit 1 if $err; # the error already reported
	die "The client $P4CLIENT has nothing\n" if !$cnt;
    }

    open(STDIN, '<', $P4HAVE_FILE) or die "$P4HAVE_FILE: $!\n";
    my ($p4have) = qx{git hash-object -t blob -w --stdin};
    die "Failed to save state of $P4CLIENT in git repo" if $?;

    #
    # Prepare commit messages
    #
    unlink("$GIT_DIR/p4/msg", "$GIT_DIR/p4/p4msg");
    open($fdo, '>', "$GIT_DIR/p4/msg"); close($fdo);
    open($fdo, '>', "$GIT_DIR/p4/p4msg"); close($fdo);

    foreach my $i (@DESC) {
	$i =~ s/^(.)//o;
	if ('c' eq $1) {
	    print "reading changes for $i\n" if $VERBOSE;
	    cl2msg($i);
	} elsif ('f' eq $1) {
	    my($o1,$o2,$i);
	    if (open($o1, '>>', "$GIT_DIR/p4/msg")) {
		if (open($o2, '>>', "$GIT_DIR/p4/p4msg")) {
		    if (open($i, '<', $i)) {
			my $n = 0;
			while(<$i>) {
			    $n++;
			    print $o1 $_;
			    print $o2 $_ if $n == 1;
			}
			close($i);
		    }
		    close($o2);
		}
		close($o1);
	    }
	} elsif ('4' eq $1) {
	    print "reading changes for $i\n" if $VERBOSE;
	    my ($change)=qx{p4 changes -m1 $i};
	    if (!defined($change) or $change !~ m/\s+(\d+)\s/) {
		die "$i does not resolve into a change number\n";
	    }
	    cl2msg($1);
	}
    }
    system("$editor $GIT_DIR/p4/msg") if $EDIT_COMMIT;

    # copy mirror-branch commit message into side-branch
    # commit message if no other description were given.
    if (!-s "$GIT_DIR/p4/p4msg") {
	open($fdi, '<', "$GIT_DIR/p4/msg") or die "$GIT_DIR/p4/msg: $!\n";
	sysread($fdi,$buf,-s "$GIT_DIR/p4/msg");
	close($fdi);
	open($fdo, '>>', "$GIT_DIR/p4/p4msg") or die "$GIT_DIR/p4/p4msg: $!\n";
	syswrite($fdo,$buf);
	close($fdo);
    }

    #
    # Store the imported file data
    #

    if ($VERBOSE < 2) {
	if ( $^O eq 'MSWin32' ) { open(STDERR, "NUL") }
	else { open(STDERR, "/dev/null") }
    }

    my ($tree) = qx{git write-tree};
    die "Failed to write current tree\n" if $?;
    $parent = length($HEAD) ? "-p $HEAD": '';
    open(STDIN, '<', "$GIT_DIR/p4/msg") or die "p4/msg: $!\n";
    $tree =~ s/\r?\n//gs;
    ($commit)=qx{git commit-tree $tree $parent};
    die "failed to commit current tree\n" if $?;
    s/\r?\n//gs for ($commit);
    print "current tree stored in commit $commit\n" if $VERBOSE;

    #
    # Storing import control data
    #
    $ENV{GIT_INDEX_FILE} = $p4x;
    open($fdo, '|-', 'git update-index --add --index-info') or
	die "could not start git update-index\n";
    binmode($fdo);
    s/\r?\n//gs for ($p4spec,$p4clnt,$p4have);
    print $fdo "100644 $p4spec\tspec\n";
    print $fdo "100644 $p4clnt\tclient\n";
    print $fdo "100644 $p4have\thave\n";
    close($fdo);
    if($?) {
	die "Failed to store $SPEC in p4import index and git repo\n".
	    "Failed to save mappings of $P4CLIENT in p4import index and git repo\n".
	    "Failed to save state of $P4CLIENT in p4import index and git repo\n"
    }
    my ($p4tree)=qx{git write-tree};
    die "Failed to store $SPEC (tree) in git repo\n" if $?;

    # Bind import control data to the file data
    $p4parent="-p $commit";
    $p4parent="$p4parent -p $p4head" if length($p4head);
    open(STDIN, '<', "$GIT_DIR/p4/p4msg") or die "p4/p4msg: $!\n";
    $p4tree =~ s/\r?\n//gs;
    ($p4commit)=qx{git commit-tree $p4tree $p4parent};
    die "Failed to store $SPEC (commit) in git repo\n" if $?;
    $p4commit =~ s/\r?\n//gs;

    # Finishing touches: update references
    system('git','update-ref','-m','backup ref of current branch',
	   'p4/backup-HEAD','HEAD');
    system('git','update-ref','-m','backup ref of p4import',
	   'p4/backup-p4import',"refs/p4import/$P4CLIENT");
    $rc = system('git','update-ref','-m','data of p4import','HEAD',$commit);
    die "Failed to update HEAD\n" if $rc;
    $rc = system('git','update-ref','-m','p4import',"refs/p4import/$P4CLIENT",$p4commit);
    die "Failed to store $SPEC (reference) in git repo\n" if $rc;

    if ($VERBOSE) {
	print STDOUT (grep {s/\r?\n//gs;s/.*?\s//} qx{git name-rev
refs/p4import/$P4CLIENT}), ":\n";
	system('git','log','--max-count=1','--pretty=format:%h %s%n',$p4commit);
    }
    print STDOUT (grep {s/\r?\n//gs;s/.*?\s//} qx{git name-rev HEAD}), ":\n";
    system('git','log','--max-count=1','--pretty=format:%h %s%n',$commit);
}