info-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Keeping a checked out copy via export - slightly more improved code


From: Jakub Narebski
Subject: Re: Keeping a checked out copy via export - slightly more improved code
Date: Fri, 13 Jul 2001 17:14:34 +0200 (CEST)

I'm sending you a little more improved version of script to keep an up to
date copy via autoexport from loginfo.  This version tries to remove files
when needed only (e.g. not trying to remove files which are added) and
export files when needed only (e.g. not trying to export files which are
removed).  Subroutines exportrev and importrev tests file revisions to
check if file needs to be removed from exported tree/exported.

There is a problem how to invoke this script.  Doing it in the naive way
will cause a problem with locks.  Using temporary file based on username
is not good either, because cvs invokes loginfo scripts _separately_ for
*each* subdirectory, so multiple dir commits (e.g. include/test.h,
src/test.c, Makefile) will not work.

The only solution I can think of is to save (append) list of files to
unlink (remove) and export in temporary files and then (after sleep 2)
invoke cvs to actually export files.  Anyone has better idea?

Feedback (at the address address@hidden or address@hidden
(this is the same address), because I am not subscribed to info-cvs
mailing list) welcomed.


The actual script (with lots of ugly debugging code) follows:
-----------------------------------------------------------------------
#!/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)      = 0;
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 = address@hidden;
                if ($debug) {
                    print "Added Files:\n";
                }
            } elsif($_ =~ /^Modified Files:$/) {
                updatelist($listref, $current_files) if $listref;
                $listref = address@hidden;
                if ($debug) {
                    print "Modified Files:\n";
                }
            } elsif($_ =~ /^Removed Files:$/) {
                updatelist($listref, $current_files) if $listref;
                $listref = address@hidden;
                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);
}
------------------------------------------------------------------------

-- 
Jakub Narębski
    Poland





reply via email to

[Prev in Thread] Current Thread [Next in Thread]