#!/usr/bin/perl -w

use strict;
use warnings;

# We use environmental variables for convenience,
# but for better security one should write paths explicitly
#my($cvs_root)        = $ENV{'CVSROOT'};
#my($export_dir)      = $ENV{'CVSEXPORT'};
my($cvs_root)        = "/usr/local/cvsroot/";
my($export_dir)      = "/exportdir/";
my(@imported_files)  = qw();
my(@files_to_unlink) = qw();
my(@files_to_export) = qw();
my($subdir)          = "";
my($log_message)     = "";

my(@unlink_list)     = qw();
my($export_string)   = "";

# Flags
my($debug)      = 1;
my($invoke_cvs) = 0;

#
# MAIN
#

# Subroutine declarations (without prototypes)
sub exportrev;  # takes pre-commit and post-commit revision number (as strings)
sub unlinkrev;  # takes pre-commit and post-commit revision number (as strings)
sub updatelist; # takes reference to array (in scalar variable) 
                # and string of space separated elements (strings) to add

# Just in case...
die "No arguments. Usage: $0 %{sVv}" unless @ARGV;

#
# Process argv[0], the list of tokens separated by space
# First token is the subdirectory (if there is any format string)
#

if ($ARGV[0] =~ /^(\S+?) (.+)$/) {
    $subdir = $1;
    
    my($rest) = $2;

    if ($debug) {
        $| = 1; # autoflush

        print "subdir = ", $subdir, "\n";
        print "rest   = ", $rest, "\n";
    }

    # loginfo might be run in at least three separate cases:
    # - cvs import [module] [vendor-tag] [release-tags]
    # - cvs add [directory]
    # - cvs commit
    #
    # In the case of 'import' we have to parse input to get file list
    if ($rest eq "- Imported sources") {
        if ($debug) {
	    print "Import.\n";
            print "Processing input.\n";
        }

	my($vendor_tag)  = "";
	my($release_tag) = "";
	my($status)      = "";

	my($inside_log);

	# One could process input part by part instead of using one loop.
	while(<STDIN>) {
	    chomp; # or chop, because this is STDIN
            if ($inside_log and $_ !~ /^Status:/ ) {
                if ($debug) {
                    print "Adding line: $_\n";
                }
		$log_message .= $_;
            } elsif ($_ =~ /^Status:/) {
                $status = $_;
                $status =~ s/^Status://;

                if ($debug) {
                    print "Status:\t>$status<\n";
                }

                undef $inside_log;
	    } elsif ($_ =~ /^Update of /) { 
                # This is not really needed, as the subdirectory is known 
		# from the first token in the argument. 
                # This is the very first line of input.
		$subdir = $_;
		$subdir =~ s|^Update of $cvs_root||g;

                if ($debug) {
                    print "Updated subdir = $subdir\n";
                }
	    } elsif ($_ =~ /^Log Message:$/) {
                if ($debug) {
                    print "Processing log message.\n";
                }  
                $inside_log = 1;
	    } elsif ($_ =~ /^Vendor Tag:\t(.*)$/) {
		$vendor_tag = $1;
                if ($debug) {
                    print "Vendor Tag:\t>$vendor_tag<\n";
                }
	    } elsif ($_ =~ /^Release Tags:\t(.*)$/) {
		$release_tag = $1;
                if ($debug) {
                    print "Release Tags:\t>$release_tag<\n";
                }
	    } elsif ($_ =~ /^(U|N) (\S+)$/) { 
                # This can lead astray for some log messages. I really
		# don't know why Log Message: is not at the end of input. 
		# For simplicity we do not detect if the Log Message
                # section has ended (see comment at beginning of loop). 
                if ($debug) {
                    print "Import line: $_\n";
                } 

                my($file_info) = $1;
		my($fname)     = $2;

		$fname =~ s|//+|/|g; # the /g is not really needed
		push(@imported_files, $fname);

                # one could check, if we really want to export vendor branch
		push(@files_to_unlink, $fname) unless $file_info eq "N";
		push(@files_to_export, $fname);
	    }
	} # while(<STDIN>)
        
        if ($debug) {
            print "Imported files: ", join(' ', @imported_files), "\n";
        }

    # In the case of adding a directory the log message is always.
    # 'Directory [fullpath in repository] added to repository'
    } elsif ($rest eq "- New directory") {
        if ($debug) {
	    print "New directory added: $subdir\n";
        }

	# Is this really needed?
	push(@files_to_export, $subdir);
	# one can create directory instead, e.g.
	#mkdir $export_dir$subdir;    

    # The following if is for security only, because I am not sure if
    # I know all loginfo invoking possibilities.
    } elsif ($rest =~ /^- /) {
	die "Unknown argument $rest";

    # The loginfo was triggered by an ordinary commit.	
    } else {
        if ($debug) {
            print "Commit in directory $subdir.\n";
        }

	# As you can easily see it's better to not have file names with spaces.
	# Workaround: use %{asVva} (and heavily change this script)
        # and you will get ,filename,in_rev,out_rev, separated by spaces. 
	my(@files_info) = split(' ', $rest);

	# First, process tokens in the arguments
	foreach my $file_info (@files_info) {
            if ($debug) {
	        print "Processing: ";
            }

	    # We assume that there are no commas in filenames
	    # and there are no "unknown fields" in format in loginfo
	    my ($fname, $in_rev, $out_rev) = split(',', $file_info);
	    # Just in case someone used %{sv} or %{s} instead of %{sVv}
	    unless (defined $out_rev) {
		$out_rev = $in_rev;
		undef $in_rev;
	    }
	    push(@files_to_unlink, $subdir . '/' . $fname) if unlinkrev($in_rev, $out_rev);
	    push(@files_to_export, $subdir . '/' . $fname) if exportrev($in_rev, $out_rev);

            if ($debug) {
	        if (unlinkrev($in_rev, $out_rev)) {
		    print "-";
	        } else {
		    print "*";
	        }
	        if (exportrev($in_rev, $out_rev)) {
		    print "+";
	        } else {
		    print "*";
	        }
	        print " $fname: $in_rev, $out_rev\n";
            }
	}

	# Then process input (if needed).  In this script the results
	# of input parsing are unused, anyway.  But one could want
	# to use for example log messages.
	my(@added_files, @modified_files, @removed_files);
	my($current_files) = "";
	my($listref);
	my($inside_log);

        if ($debug) {
	    print "Processing input.\n";
        }

	while(<STDIN>) {
	    chomp $_;
	    # We could get subdir from the 'Update of' line
	    # but we don't do this.
	    if ($inside_log) {
                if ($debug) {
                    print "Adding line: $_\n";
                }
		$log_message .= $_;

	    # The code is somewhat redundant, but I don't know how to write it better.
	    # I am novice in Perl, you know...
	    # One could use $currentFiles to writeout header like in commit editor.
	    } elsif($_ =~ /^Added Files:$/) {
		updatelist($listref, $current_files) if $listref;
		$listref = \@added_files;
                if ($debug) {
                    print "Added Files:\n";
                }
	    } elsif($_ =~ /^Modified Files:$/) {
		updatelist($listref, $current_files) if $listref;
		$listref = \@modified_files;
                if ($debug) {
                    print "Modified Files:\n";
                }
	    } elsif($_ =~ /^Removed Files:$/) {
		updatelist($listref, $current_files) if $listref;
		$listref = \@removed_files;
                if ($debug) {
                    print "Removed Files:\n";
                }

	    # Catch file names.
	    } elsif($listref and $_ =~ /^\t/) { # catch files
		$current_files .= $_;
                if ($debug) {
                    print "$_\n";
                }

	    # Log Message last till the end of the file.
	    } elsif($_ =~ /^Log Message:$/) {
		undef $listref;
		$inside_log = 1; # Log Message is to the end of the input
                if ($debug) {
                    print "Processing log message.\n";
                }  
	    }

	    # Just in case, $listref should be undefined anyway.
	    updatelist($listref, $current_files) if $listref;
	}
    }
} else {
    die "Unknown arguments. Use $0 %{sVv}";
}

#
# remove any existing versions of the files
#

if ($debug) {
    print "There are ", $#files_to_unlink+1, " files to remove.\n"; 
    print "There are ", $#files_to_export+1, " files to export.\n"; 
}

if ($#files_to_unlink >= 0) {
    #unlink(map {$export_dir . '/' . $_ } @files_to_unlink);
    if (substr ($export_dir, -1) eq "/") {
	@unlink_list = map {$export_dir . $_ } @files_to_unlink;
     } else { 
	@unlink_list = map {$export_dir . '/' . $_ } @files_to_unlink;
     }

    if ($debug) {
        print "Files to unlink:\n";
        print join(' ', @files_to_unlink), "\n";
        print "Files to unlink (full path):\n";
        print join(' ', @unlink_list) . "\n";
    }

    if ($invoke_cvs) {
        unlink @unlink_list;
    } else {
        print join(' ', @unlink_list) . "\n";
    }
}

#
# export the files
#
if ($#files_to_export >= 0) {
    $export_string = join(' ',@files_to_export);
    #umask 002; # umask command is available only in csh and bash shells
    #my($output) = `cd $export_dir; /usr/bin/cvs -d $cvs_root export -D now $export_string`;

    if ($debug) {
        print "Files to export (relative to $cvs_root):\n";
        print $export_string, "\n";
    }

    if ($invoke_cvs) {
        my($output) = `cd $export_dir; /usr/bin/cvs -d $cvs_root export -D now $export_string`;
    } else {
        print $export_dir . " " . $export_string . "\n";
    }
}

if ($debug and $log_message) {
    print "Log Message:\n";
    print $log_message, "\n";
}

## ----------------------------------------------------------------------

#
# SUBROUTINES
#

# test revision numbers to decide if this file should be exported to
# $export_dir (should be added to @files_to_export)
sub exportrev {
    my($in_rev, $out_rev) = @_;

    # If $out_rev id "NONE" then this file was removed.
    # We don't export files which are not in main trunk.
    if ($out_rev eq "NONE" or $out_rev !~ /^\d+.\d+$/) {
	return 0;
    } else {
	return 1;
    }
} 

# test revision numbers to decide if this file should be removed from
# $export_dir (should be added to @files_to_unlink)
sub unlinkrev {
    my($in_rev, $out_rev) = @_;

    # If $in_rev is "NONE" then this file was added.
    # We don't need to check the branch.
    if ($in_rev eq "NONE") {
	return 0;
    }

    # If $out_rev is "NONE" then this file was removed.
    # We should test the $in_rev to check if it was removed
    # from the main trunk (remove) or from branch (leave).
    if ($out_rev eq "NONE" and $in_rev =~ /^\d+.\d$/) { 
	return 1;
    }

    # Otherwise (file was not removed nor added) remove this file from
    # $export_dir only if you export it.  
    return exportrev($in_rev, $out_rev); 
}


# update array of files with filenames in space separated string
sub updatelist {
    my($arrayref, $string) = @_;
    
    # trim whitespaces
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;

    # add elements to array
    @$arrayref = split(' ', $string);
}