#!/usr/bin/perl
#
# p4tocvs.pl: Convert a Perforce P4 Sourcecode Archive to CVS
#
# Copyright (c) 2000 Joachim Feise (jfeise at feise dot com).
# Last modification: 2000-Apr-10
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# You can also view the GNU General Public License on the
# World Wide Web at http://www.gnu.org/copyleft/gpl.html


sub usage
{
    print "$0: Convert a Perforce P4 Sourcecode Archive to CVS\n";
    print "Copyright (c) 2000 Joachim Feise (jfeise at ics dot uci dot edu)\n";
    print "Released under the GNU GPLv2 (http://www.gnu.org/copyleft/gpl.html)\n";
    print "Usage:\n";
    print "\t$0 [-v] checkpoint p4-directory cvs-directory\n";
    print "Options:\n";
    print "\t-v\tVerbose output\n";
    print "Example:\n";
    print "\t$0 /home/p4/checkpoint.3 /home/p4 /home/cvs\n";
    print "Before running this program, make sure you have a backup of your P4 depot\n";
    print "directory.\n";
    print "You should also decompress all binary files in the depot with this command:\n";
    print "\tfind /home/p4/depot -name '*.gz' -exec gunzip {} \\;\n";
    print "\n";
    exit;
}


# Find the username and machine associated with the job and id
sub findUser
{
    local( *a, *job, *id, *machine, *user ) = @_;
    local($tmp1);
    local( $job2, $id2 );
    foreach( @a )
    {
        ($job2, $tmp1, $machine, $user, $id2) = split( /[ @]+/, $_ );
        if( $job == $job2 && $id eq $id2 )
        {
            return;
        }
    }
}


sub createDirectory
{
    local( $fname ) = @_;
    local( @parts );
    local( $dir );
    (@parts) = split( '/', $fname );
    pop( @parts );
    $dir = "";
    foreach( @parts )
    {
        $dir = $dir."/".$_;
        if( !-d $dir )
        {
            mkdir( $dir, 0775 );
        }
    }
}


sub printValue
{
    local( *FILE, $value ) = @_;
    if( $value < 10 )
    {
        print FILE "0";
    }
    print FILE $value;
}


sub getLabel
{
    local( *label, *have, *fname, *version, *retlabel ) = @_;

    foreach( @have )
    {
        local( $lbl );
        local( $ver );
        ($tmp1, $lbl, $tmp2, $file, $tmp3) = split( '@', $_ );
        # remove leading '//depot/'
        substr( $file, 0, 8 ) = "";

        ($ver) = split( ' ', $tmp3 );
        ($tmp1, $lbl, $tmp2) = split( /[\/]+/, $lbl );
        foreach( @label )
        {
            if( $lbl eq $_ && $file eq $fname && $ver == $version )
            {
                $retlabel = $lbl;
                return;
            }
        }
    }
}


# Escape a couple of characters that the FS doesn't like otherwise
sub escapeFile
{
    local( *file ) = @_;
    local( @d ) = split( /\$/, $file );
    $file = join( "\\\$", @d );
    @d = split( ' ', $file );
    $file = join( "\\ ", @d );
    @d = split( '\'', $file );
    $file = join( "\\\'", @d );
    @d = split( '&', $file );
    $file = join( "\\&", @d );
}


sub updateBinaryFile
{
    local( $name, *version, *author, $state ) = @_;
    local( *INFILE, *OUTFILE );
    local( $buf, $buf1, $buf2 );
    local( $headindex ) = 0;
    local( $dateindex ) = -1;
    local( $semicolon );

    if( $state eq "dead" )
    {
        # just return if error
        open( INFILE, $name ) || return;
    }
    else
    {
        open( INFILE, $name ) || die "CVS binary file open error: $name\n";
    }
    binmode( INFILE );
    open( OUTFILE, "> $name,tmp" ) || die "CVS binary file creation error: $name,tmp\n";
    binmode( OUTFILE );
    read( INFILE, $buf1, 512 );
    while( $dateindex < 0 )
    {
        if( read( INFILE, $buf2, 512 ) <= 0 )
        {
            print OUTFILE $buf1;
            return;
        }
        $buf = join ("", $buf1, $buf2 );
        if( $dateindex < 0 )
        {
            if( $state eq "dead" )
	    {
                $verstr = "\ndate\t";

	    }
            else
	    {
                $verstr = "\n$version\ndate\t";
	    }
            $dateindex = index( $buf, $verstr );
            if( $dateindex >= 0 )
            {
                # copy everything up to and including the version and date strings
                print OUTFILE substr( $buf, 0, $dateindex + length( $verstr ) );
                substr( $buf, 0, $dateindex + length( $verstr ) ) = "";
                if( $#buf < 28 )
                {
                    read( INFILE, $buf2, 512 );
                    $buf = join( "", $buf, $buf2 );
                }
                # copy the date and the literal author text
                print OUTFILE substr( $buf, 0, 28 );
                # write the author
                print OUTFILE $author;
                substr( $buf, 0, 28 ) = "";
                $semicolon = index( $buf, ";" );
                if( $semicolon == -1 )
                {
                    read( INFILE, $buf2, 512 );
                    $buf = join( "", $buf, $buf2 );
                    $semicolon = index( $buf, ";" );
                }
                # remove the old author
                substr( $buf, 0, $semicolon+1 ) = "";
                # print the state
                print OUTFILE ";\tstate ", $state;
                $semicolon = index( $buf, ";" );
                if( $semicolon == -1 )
                {
                    read( INFILE, $buf2, 512 );
                    $buf = join( "", $buf, $buf2 );
                    $semicolon = index( $buf, ";" );
                }
                # remove the old state
                substr( $buf, 0, $semicolon ) = "";
            }
        }
        print OUTFILE substr( $buf, 0, length( $buf ) - 30 );
        substr( $buf, 0, length( $buf ) - 30 ) = "";
        $buf1 = $buf;
    }
    print OUTFILE $buf1;
    while( read( INFILE, $buf, 1024 ) )
    {
        print OUTFILE $buf;
    }
    close INFILE;
    close OUTFILE;
    unlink $name;
    rename "$name,tmp", $name;
}


sub checkAttic
{
    local( *name, *version, $comment, *author, *label ) = @_;
    local( @data );
    local( $tmp1, $tmp2 );
    local( $fname, $dir );
    local( @dir );
    local( $infile ) = "$ARGV[1]/depot/$name";
    @dir = split( '/', $name );
    $fname = pop @dir;

    $dir = join( '/', "$ARGV[2]", @dir,  "Attic" );
    &escapeFile( *infile );
    if( !-e "$ARGV[1]/depot/$name,v" )
    {
        if( !-e "$ARGV[1]/depot/$name,d/$version" )
	{
            # assume binary file
            &updateBinaryFile( "$ARGV[2]/$name,v", *version, *author, "dead" );
            if( -e "$ARGV[2]/$name,v" )
	    {
                if( !-d $dir )
                {
                    mkdir( $dir, 0775 );
                }
                rename "$ARGV[2]/$name,v", "$dir/$fname,v";
                print "Binary file $ARGV[2]$name,v moved to attic\n";
	    }
	}
        return;
    }
    local( $outfile ) = "$ARGV[2]/$name";
    &escapeFile( *outfile );
    if( -e "$ARGV[2]/$name,v" )
    {
        @data = split( /\n/, `cat $outfile,v` );
    }
    else
    {
        return;
    }
    local( $dead ) = 0;
    local( $currentdate );
    local( $lastGoodVersion );
    local( $i ) = 0;
    while( $i <= $#data )
    {
        if( $i == 0 )
        {
            ($tmp1, $lastGoodVersion, $tmp2) = split( /[ ;]+/, $data[$i] );
            local( $goodMajor, $goodMinor );
            local( $major, $minor );
            ($goodMajor, $goodMinor) = split( '\.', $lastGoodVersion );
            ($major, $minor) = split( '\.', $version );
            if( $goodMajor > $major || ($goodMajor == $major && $goodMinor >= $minor) )
            {
                # no need to investigate further, file does not
                # belong in attic
                return;
            }
            # write new head
            #splice( @data, $i, 1, "head\t$lastGoodVersion;" );
            $dead = 1;
        }
        if( $dead == 1 && $data[$i] eq $lastGoodVersion && $data[$i+1] ne "log" )
        {
            ($tmp1, $currentdate, $tmp2) = split( /[ ;]+/, $data[$i+1] );
            splice( @data, $i, 2, "$lastGoodVersion", "date\t$currentdate;\tauthor\t$author;\tstate\tdead;" );
            local( *FILE );
            local( $outfile ) = "$ARGV[2]/$name";
            &escapeFile( *outfile );
            open( FILE, "> $ARGV[2]/$name,v" ) || die "CVS text file open error: $ARGV[2]/$name,v";
            print FILE join( "\n", @data );
            print FILE "\n";
            close FILE;
            chmod 0664, "$ARGV[2]/$name,v";
            if( !-d $dir )
            {
                mkdir( $dir, 0775 );
            }
            rename "$ARGV[2]/$name,v", "$dir/$fname,v";
            print "File $ARGV[2]/$name,v moved to attic\n";
            return;
        }
        $i++;
    }
}


sub addBinaryFile
{
    local( *name, *version, $comment, *author, *label ) = @_;
    local( @allfiles );
    local( $i );
    local( $buf, @stats );
    local( $ferr );

    if( !-d "$ARGV[1]/depot/$name,d" )
    {
        # error
        print "Directory or File not found: $ARGV[1]/depot/$name,d or $ARGV[1]/depot/$name,v\n";
        return;
    }

    local( *BINDIR );
    opendir( BINDIR, "$ARGV[1]/depot/$name,d" ) || die "P4 Binary directory open error: $ARGV[1]/depot/$name,d";
    @allfiles = grep( !/^\./, readdir( BINDIR ) );
    closedir( BINDIR );
    @allfiles = reverse( sort @allfiles );
    local( *FILE );
    $zipped = 0;
    # Escape special chars
    local( $infile ) = "$ARGV[1]/depot/$name,d/$version";
    &escapeFile( *infile );
    if( !-e "$ARGV[1]/depot/$name,d/$version" )
    {
        if( !-e "$ARGV[1]/depot/$name,d/$version.gz" )
        {
            print "File $ARGV[1]/depot/$name,d/$version.gz not found.\n";
            return;
        }
        `gunzip $infile.gz`;
        if( !-e "$ARGV[1]/depot/$name,d/$version" )
        {
            print "gunzip error for $infile\n";
            $ferr = 1;
        }
        $zipped = 1;
    }

#####
## SAVE FRAMEWORK THE FIRST TIME AROUND, LATER JUST ADD NEW STUFF
## NOTE: This code relies on the highest revision being written first

    local( $outfile ) = "$ARGV[2]/$name";
    &escapeFile( *outfile );
    if( !-e "$ARGV[2]/$name,v" )
    {
        &createDirectory( "$ARGV[2]/$name" );
        open( FILE, "> $ARGV[2]/$name,v" ) || die "CVS binary file open error: $ARGV[2]/$name,v";
        if( substr( $allfiles[0], -3, 3 ) eq ".gz" )
        {
            substr( $allfiles[0], -3, 3 ) = '';
        }
        print FILE "head\t", $allfiles[0], ";\n";
        print FILE "access;\n";
        if( $label eq "" )
        {
            print FILE "symbols;\n";
        }
        else
        {
            print FILE "symbols\n\t$label:$version;\n";
        }
        print FILE "locks; strict;\n";
        print FILE "comment @# @;\n";
        print FILE "expand\t\@b@;\n\n\n";
        $i = 0;
        while( $i <= $#allfiles )
        {
            if( substr( $allfiles[$i], -3, 3 ) eq ".gz" )
            {
                substr( $allfiles[$i], -3,3 ) = '';
            }
            print FILE $allfiles[$i], "\n";
       	    local( @stats );
            local( @gmdate );
            local( $year );
            local( $month );
            @stats = stat( "$ARGV[1]/depot/$name,d/$allfiles[$i]" );
            @gmdate = gmtime( $stats[9] );
            $year = 1900 + $gmdate[5];
            $month = $gmdate[4] + 1;
            print FILE "date\t", $year, ".";
            &printValue( *FILE, $month );
            print FILE ".";
            &printValue( *FILE, $gmdate[3] );
            print FILE ".";
            &printValue( *FILE, $gmdate[2] );
            print FILE ".";
            &printValue( *FILE, $gmdate[1] );
            print FILE ".";
            &printValue( *FILE, $gmdate[0] );
            print FILE ";\tauthor ", $author, ";\tstate Exp;\n";
            print FILE "branches;\n";
            print FILE "next\t";
            if( $i != $#allfiles )
            {
                print FILE "$allfiles[$i+1]";
            }
            print FILE ";\n\n\n";
            $i++;
        }
        print FILE "desc\n@@\n\n";
    }
    else
    {
        # Change author for previous versions if necessary
        &updateBinaryFile( "$ARGV[2]/$name,v", *version, *author, "Exp" );
        open( FILE, ">> $ARGV[2]/$name,v" ) || die "CVS binary file open error: $$ARGV[2]/$name,v";
    }
    print FILE "\n", $version, "\n";
    print FILE "log\n@", $comment, "\n@\n";
    print FILE "text\n@";
    close FILE;
    if( $ferr == 0 )
    {
        local( *INFILE );
        open( INFILE, "$ARGV[1]/depot/$name,d/$version" ) || die "P4 binary file open error: $ARGV[1]/depot/$name,d/$version";
        binmode( INFILE );
        open( FILE, ">> $ARGV[2]/$name,v" ) || die "CVS binary file open error: $ARGV[2]/$name,v";
        binmode( FILE );
        while( read( INFILE, $buf, 1024 ) )
        {
            local( $pos );
            while(( $pos = index( $buf, "@" ) ) >= 0 )
            {
                print FILE substr( $buf, 0, $pos );
                print FILE "@@";
                substr( $buf, 0, $pos+1 ) = "";
            }
            print FILE $buf;
        }
        close INFILE;
        close FILE;
    }
    open( FILE, ">> $ARGV[2]/$name,v" ) || die "CVS binary file open error: $ARGV[2]/$name,v";
    print FILE "@\n\n";
    close FILE;
    chmod 0664, "$ARGV[2]/$name,v";
    if( $zipped == 1 )
    {
        `gzip $infile`;
    }
}


# Write the comments to the actual RCS file
sub modifyFile
{
    local( *name, *version, $comment, *author, *label ) = @_;
    local( @data );
    local( $tmp1, $tmp2 );
    local( $infile ) = "$ARGV[1]/depot/$name";
    &escapeFile( *infile );
    if( !-e "$ARGV[1]/depot/$name,v" )
    {
        &addBinaryFile( *name, *version, $comment, *author, *label );
        return;
    }
    local( $outfile ) = "$ARGV[2]/$name";
    &escapeFile( *outfile );
    if( -e "$ARGV[2]/$name,v" )
    {
        @data = split( /\n/, `cat $outfile,v` );
    }
    else
    {
        @data = split( /\n/, `cat $infile,v` );
    }
    local( $labelinserted ) = 0;
    local( $i ) = 0;
    while( $i <= $#data )
    {
        if( $i == 3 )
        {
            ($tmp1, $tmp2) = split( ' ', $data[$i] );
            if( $tmp2 eq ";comment" )
            {
                splice( @data, $i, 1, "locks; strict;", "comment @# @;" );
            }
        }
        if( $data[$i] eq $version && $data[$i+1] eq "log" && $data[$i+2] eq "@@" )
        {
            splice( @data, $i+2, 1, "@".$comment, "@" );
        }
        if( $label ne "" )
        {
            if( $data[$i] eq "symbols  ;" || $data[$i] eq "symbols;" )
            {
                splice( @data, $i, 1, "symbols", "\t$label:$version;" );
                $labelinserted = 1;
            }
            elsif( $data[$i] eq "symbols" )
            {
                splice( @data, $i, 1, "symbols", "\t$label:$version" );
                $labelinserted = 1;
            }
            #print "Label: ", $label, ", Version: ", $version, "\n";
        }
        $i++;
    }
    if( $label ne "" && $labelinserted != 1 )
    {
        splice( @data, 2, 0, "symbols", "\t$label:$version;" );
    }

    local( *FILE );
    local( $outfile ) = "$ARGV[2]/$name";
    &escapeFile( *outfile );
    &createDirectory( "$ARGV[2]/$name" );
    if( -e "$ARGV[2]/$name,v" )
    {
        chmod 0664, "$ARGV[2]/$name,v";
    }
    open( FILE, "> $ARGV[2]/$name,v" ) || die "CVS text file open error: $ARGV[2]/$name,v";
    print FILE join( "\n", @data );
    print FILE "\n";
    close FILE;
    chmod 0664, "$ARGV[2]/$name,v";
}


# Main program
$verbose = 0;
if( $#ARGV >= 0 && $ARGV[0] eq "-v" )
{
    $verbose = 1;
    shift @ARGV;
}
if( $#ARGV < 2 )
{
    &usage;
}

@data = split( /\n/, `cat $ARGV[0]` );

# combine data stretching multiple lines
$i = 0;
while( $i <= $#data )
{
    ($pv, $tmp1 ) = split( ' ', @data[$i], 2 );
    if( $pv ne "\@pv@" )
    {
        $curline = @data[$i-1].@data[$i];
        splice( @data, $i-1, 2, $curline );
    }
    else
    {
        $curline = $_;
        $i++;
    }
}

# separate data objects
foreach( @data )
{
    local($tmp1);
    local($tmp2,$tmp3);
    ($tmp1, $tmp2, $name, $line) = split( ' ', $_, 4 );
    chop( $name );
    substr( $name, 0, 1) = "";
    if( $name eq "db.have" )
    {
        push( @have, $line );
    }
    elsif( $name eq "db.rev" )
    {
        push( @rev, $line );
    }
    elsif( $name eq "db.revcx" )
    {
        push( @revcx, $line );
    }
    elsif( $name eq "db.change" )
    {
        push( @change, $line );
    }
    elsif( $name eq "db.desc" )
    {
        push( @desc, $line );
    }
    elsif( $name eq "db.counters" )
    {
        push( @counters, $line );
    }
    elsif( $name eq "db.user" )
    {
        push( @user, $line );
    }
    elsif( $name eq "db.domain" )
    {
        push( @domain, $line );
    }
    elsif( $name eq "db.view" )
    {
        push( @view, $line );
    }
    elsif( $name eq "db.integ" )
    {
        push( @integ, $line );
    }
    elsif( $name eq "db.locks" )
    {
        push( @locks, $line );
    }
    elsif( $name eq "db.working" )
    {
        push( @working, $line );
    }
    elsif( $name eq "db.protect" )
    {
        push( @protect, $line );
    }
    else
    {
        print $tmp1, ":", $tmp2, ":", $name, ":", $_, "\n";
    }
}


# create job/comment association
foreach( @desc )
{
    local( $comment );
    local( $job );
    local( @cr );
    ($job, $comment) = split( /[ @]+/, $_, 2 );
    substr( $comment, -2 ) = '';
    @cr = split( /\r/, $comment );
    $comment = join ( ' ', @cr );
    $comment{$job} = $comment;
}


# get labels
foreach( @domain )
{
    local( $label );
    ($tmp1, $label, $num, $tmp2) = split( /[ @]+/, $_, 4 );
    if( $num == 108 )
    {
        push( @label, $label );
    }
}


# extract filename, revision and comment
foreach( @rev )
{
    ($tmp1, $name, $tmp2, $tmp3, $tmp4, $version2, $tmp5) = split( '@', $_ );
    $name = substr( $name, 8 );
    ($version1, $tmp1, $tmp2, $job, $id ) = split( ' ', $tmp2 );

    $machine = "";
    $user = "";

    &findUser( *change, *job, *id, *machine, *user );

    $ourlbl = "";
    &getLabel( *label, *have, *name, *version1, *ourlbl );

    if( $verbose == 1 )
    {
        print "File: ", $name, "\n\tRevision: ", $version2, "\n\tAuthor: ", $user, "\n\tComment: ", $comment{$job}, "\n\tLabel: ", $ourlbl, "\n";
    }
    else
    {
        if( $version1 == 1 )
	{
             print "File ", $name, "\n";
	}
    }

    &modifyFile( *name, *version2, $comment{$job}, *user, *ourlbl );
}


# move to attic if necessary
foreach( @rev )
{
    ($tmp1, $name, $tmp2, $tmp3, $tmp4, $version2, $tmp5) = split( '@', $_ );
    $name = substr( $name, 8 );
    ($version1, $tmp1, $tmp2, $job, $id ) = split( ' ', $tmp2 );

    $machine = "";
    $user = "";

    &findUser( *change, *job, *id, *machine, *user );

    $ourlbl = "";
    &getLabel( *label, *have, *name, *version1, *ourlbl );

    &checkAttic( *name, *version2, $comment{$job}, *user, *ourlbl );
}