Subversion Repositories DevTools

########################################################################

# Copyright (C) 1998-2008 ERG Limited, All rights reserved

#

# Module name   : jats_svn.pl

# Module type   : Jats Utility

# Compiler(s)   : Perl

# Environment(s): Jats

#

# Description   : A script to perform a number of SVN utility functions

#                 The script will:

#                   Delete a package

#                   Create a package

#                   Import source to a package

#

#

#......................................................................#

require 5.006_001;

use strict;

use warnings;

use JatsError;

use JatsSvn qw(:All);

use JatsLocateFiles;

use Pod::Usage;                                 # required for help support

use Getopt::Long qw(:config require_order);     # Stop on non-option

use Cwd;

use File::Path;

use File::Copy;

use File::Basename;

use File::Compare;

my $VERSION = "1.0.0";                          # Update this

#

#   Options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};            # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};          # Allow global verbose

my $opt_help = 0;

#

#   Globals

#

my $opr_done;                                   # User has done something

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

# Function        : Mainline Entry Point

#

# Description     :

#

# Inputs          :

#

my $result = GetOptions (

                "help:+"        => \$opt_help,              # flag, multiple use allowed

                "manual:3"      => \$opt_help,              # flag

                "verbose:+"     => \$opt_verbose,           # flag, multiple use allowed

                );

                #

                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!

                #

#

#   Process help and manual options

#

pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);

pod2usage(-verbose => 1) if ($opt_help == 2 );

pod2usage(-verbose => 2) if ($opt_help > 2);

#

#   Configure the error reporting process now that we have the user options

#

ErrorConfig( 'name'    =>'SVN',

             'verbose' => $opt_verbose,

            );

#

#   Reconfigure the optiosn parser to allow subcommands to parse options

#

Getopt::Long::Configure('permute');

#

#   Process command

#   First command line argument is a subversion command

#

my $cmd = shift @ARGV || "help";

CreatePackage()                        if ( $cmd =~ m/^create/ );

DeletePackage()                        if ( $cmd =~ m/^delete-package/ );

ImportPackage()                        if ( $cmd =~ m/^import/ );

SvnRepoCmd($cmd, @ARGV)                if ( $cmd eq 'ls' );

TestSvn()                              if ($cmd eq 'test');

pod2usage(-verbose => 0, -message => "No valid operations specified") unless ( $opr_done );

exit 0;

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

# Function        : TestSvn

#

# Description     : Test access to subversion

#

# Inputs          : None

#

# Returns         :

#

sub TestSvn

{

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || Error ("Invalid command line" );

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Test Subversion") if ($opt_help || $#ARGV >= 0);

    SvnUserCmd( '--version');

    $opr_done = 1;

}

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

# Function        : SvnRepoCmd

#

# Description     : Execute a SVN command, where the first argument

#                   is a repository specifier

#

# Inputs          : $cmd

#                   $repo_url

#                   @opts

#

# Returns         : 

#

sub SvnRepoCmd

{

    my ( $cmd, $repo_url, @opts ) = @_;

    my $uref = NewSessionByUrl ( $repo_url );

    SvnUserCmd( $cmd,

            $uref->Full,

            @opts,

            { 'credentials' => 1 });

    $opr_done = 1;

}

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

# Function        : DeletePackage

#

# Description     : Delete a Package structure within a Repository

#                   Intended for test usage

#

# Inputs          : URL                 - Url to Repo + Package Base

#

# Returns         : 

#

sub DeletePackage

{

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || Error ("Invalid command line" );

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Delete a Package") if ($opt_help || $#ARGV < 0);

    #

    #   Sanity Tests

    #

    Message ("Delete Entire Package Tree" );

    Warning ("Too many arguments: @ARGV") if ( $#ARGV >= 1 );

    #

    #   Do all the hard work

    #       Create

    #       Import

    #       Label

    #

    my $uref = NewSessionByUrl ( $ARGV[0] );

    $uref->SvnValidatePackageRoot();

    $uref->SvnDelete (

                      'target'      => $uref->Full,

                      'comment'   => ['Deleted by user command','jats svn delete-package'],

                      'noerror'     => 0,

                      );

    $opr_done = 1;

}

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

# Function        : CreatePackage

#

# Description     : Create a Package structure within a Repository

#                   Optionally Import Data

#                   Optionally Tag the import

#                   Optionally Tag the import on a branch

#

# Inputs          : URL                 - Url to Repo + Package Base

#                   Options             - Command modifiers

#                       -import=path    - Import named directory

#                       -label=name     - Label the result

#                       -tag=name       - Import to Tag Only

#                       -branch=name    - Import to Branch only

#                       -new            - Must be new package

#                       -replace        - Replace existing

#

# Returns         : 

#

sub CreatePackage

{

    my $opt_import;

    my $opt_tag;

    my $opt_branch;

    my $opt_trunk;

    my $opt_new;

    my $opt_label;

    my $opt_replace;

    my $pname;

    my $type;

    Message ("Create New Package Version" );

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "verbose:+"     => \$opt_verbose,

                "import=s"      => \$opt_import,

                "new"           => \$opt_new,

                "branch=s"      => \$opt_branch,

                "trunk"         => \$opt_trunk,

                "tag=s"         => \$opt_tag,

                "label=s"       => \$opt_label,

                "replace"       => \$opt_replace,

                ) || Error ("Invalid command line" );

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Create a Package Version") if ($opt_help || $#ARGV < 0);

    #

    #   Alter the error reporting paramters

    #

    ErrorConfig( 'verbose' => $opt_verbose );

    #

    #   Sanity Tests

    #

    my $count = 0;

    $count++ if ( $opt_trunk );

    $count++ if ( $opt_branch );

    $count++ if ( $opt_tag );

    Error ("Conflicting options: -trunk, -tag, -branch") if ( $count > 1 );

    Error ("Nothing imported to be labeled") if ( $count && !$opt_import );

    Error ("Import path does not exist: $opt_import") if ( $opt_import && ! -d $opt_import );

    Error ("Conflicting options: new and replace") if ( $opt_new && $opt_replace );

    ($type, $opt_label) = ('tags', $opt_tag)            if ( $opt_tag);

    ($type, $opt_label) = ('branches', $opt_branch)     if ( $opt_branch );

    ($type, $opt_label) = ('trunk', $opt_label)         if ( $opt_trunk);

    #

    #   Do all the hard work

    #       Create

    #       Import

    #       Label

    #

    my $uref = NewSessionByUrl ( $ARGV[0] );

    $uref->SvnCreatePackage (

                      'import'  => $opt_import,

                      'label'   => $opt_label,

                      'type'    => $type,

                      'new'     => $opt_new,

                      'replace' => $opt_replace,

                      );

    Message ("Repository Ref: " . $uref->RmRef);

    $opr_done = 1;

}

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

# Function        : ImportPackage

#

# Description     : Import a new version of a package

#                   Take great care to reuse file-versions that are already in

#                   the  package

#

#                   Intended to allow the imprtation of multiple

#                   versions of a package

#

# Inputs          : 

#

# Returns         : 

#

sub ImportPackage

{

    Message ("Import Package Version" );

    #

    #   Options

    #

    my $opt_package;

    my $opt_dir;

    my $opt_label;

    my $opt_replace = 0;

    my $opt_reuse;

    my $opt_workdir = "SvnImportDir";

    my $opt_delete = 1;

    #

    #   Other globals

    #

    my $url_label;

    #

    #   Configuration options

    #

    my $result = GetOptions (

                    "help:+"        => \$opt_help,

                    "manual:3"      => \$opt_help,

                    "verbose:+"     => \$opt_verbose,

                    "package=s"     => \$opt_package,

                    "dir=s"         => \$opt_dir,

                    "label=s"       => \$opt_label,

                    "replace"       => \$opt_replace,

                    "reuse"         => \$opt_reuse,

                    "workspace=s"   => \$opt_workdir,

                    "delete!"       => \$opt_delete,

                    #

                    #   Update documentation at the end of the file

                    #

                    ) || Error ("Invalid command line" );

    #

    #   Insert defaults

    #   User can specify base package via -package or a non-options argument

    #

    $opt_package = $ARGV[0] unless ( $opt_package );

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Import directory to a Package")

        if ($opt_help || ! $opt_package );

    #

    #   Alter the error reporting paramters

    #

    ErrorConfig( 'verbose' => $opt_verbose );

    #

    #   Configure the error reporting process now that we have the user options

    #

    Error ("No package URL specified") unless ( $opt_package );

    Error ("No base directory specified") unless ( $opt_dir );

    Error ("Invalid base directory: $opt_dir") unless ( -d $opt_dir );

    #

    #   Create an SVN session

    #

    my $svn = NewSessionByUrl ( $opt_package );

    #

    #   Ensure that the required label is available

    #

    if ( $opt_label )

    {

        $opt_label = SvnIsaSimpleLabel ($opt_label);

        $url_label = $svn->BranchName( $opt_label, 'tags' );

        $svn->SvnValidateTarget (

                        'target' => $url_label,

                        'available' => 1,

                        ) unless ( $opt_replace );

    }

    #

    #   Create a workspace based on the users package

    #   Allow the workspace to be reused to speed up multiple

    #   operations

    #

    unless ( $opt_reuse && -d $opt_workdir )

    {

        Message ("Creating Workspace");

        rmtree( $opt_workdir );

        $svn->SvnValidatePackageRoot ();

        #DebugDumpData( 'Svn', $svn );

        $svn->SvnValidateTarget (

                            'cmd'    => 'SvnImporter',

                            'target' => $svn->Full,

                            'require' => 1,

                            );

        $svn->SvnCo ( $svn->Full . '/trunk', $opt_workdir );

        Error ("Cannot locate the created Workspace")

            unless ( -d $opt_workdir );

    }

    else

    {

        Message ("Reusing Workspace");

    }

    #

    #   Determine differences between the two folders

    #       Create structures for each directory

    #

    Message ("Determine Files in packages");

    my $search = JatsLocateFiles->new("--Recurse=1",

                                       "--DirsToo",

                                       "--FilterOutRe=/\.svn/",

                                       "--FilterOutRe=/\.svn\$",

                                       "--FilterOutRe=^/${opt_workdir}\$",

                                       "--FilterOutRe=^/${opt_workdir}/",

                                       );

    my @ws = $search->search($opt_workdir);

    my @dir = $search->search($opt_dir);

    #Information ("WS Results", @ws);

    #Information ("DIR Results", @dir);

    #

    #   Create a hash the Workspace and the User dir

    #   The key will be file names

    #

    my %ws;  map ( $ws{$_} = 1 , @ws );

    my %dir; map ( $dir{$_} = 1 , @dir );

    #

    #   Create a hash of common elements

    #   Removing then from the other two

    #

    my %common;

    foreach ( keys %ws )

    {

        next unless ( exists $dir{$_} );

        $common{$_} = 1;

        delete $ws{$_};

        delete $dir{$_};

    }

    #DebugDumpData( 'WS', \%ws );

    #DebugDumpData( 'DIR', \%dir );

    #DebugDumpData( 'COMMON', \%common );

    #

    #   Add New Files

    #   Won't add empty directories at this point

    #

    #   Process by sorted list

    #   This will ensure we process parent directories first

    #

    my @added = sort keys %dir;

    if ( @added )

    {

        foreach my $file ( @added  )

        {

            my $src = "$opt_dir/$file";

            my $target = "$opt_workdir/$file";

            if ( -d $src )

            {

                mkdir ( $target ) unless (-d $target);

            }

            else

            {

                my $path = dirname ( $target);

                mkdir ( $path ) unless (-d $path);

                Verbose ("Adding $file");

                unless (File::Copy::copy( $src, $target ))

                {

                    Error("Failed to transfer file [$file]: $!");

                }

            }

        }

        #

        #   Inform Subversion about the added files

        #   The command line does have a finite length, so add them 200 at a

        #   time.

        #

        my $base = 0;

        my $num = $#added;

        Message ("Update the workspace: Added $num files");

        while ( $base <= $num )

        {

            my $end = $base + 200;

            $end = $num if ( $end > $num );

            $svn->SvnCmd ( 'add'

                            , '--depth=empty'

                            , '--parents'

                            , map ("$opt_workdir/$_", @added[$base .. $end] ),

                            { 'error' => 'Adding files to workspace' } );

            $base = $end + 1;

        }

    }

    #

    #   Remove files

    #   Don't really need to delete the files as the svn delete

    #   comamdn will do this too. Just do it anyway

    #

    my @rm_files = sort keys %ws;

    if ( @rm_files )

    {

        foreach my $file ( @rm_files  )

        {

            Verbose ("Removing $file");

            unlink "$opt_workdir/$file";

        }

        #

        #   Inform Subversion about the removed files

        #

        my $base = 0;

        my $num = $#rm_files;

        Message ("Update the workspace: Removed $num Files");

        while ( $base <= $num )

        {

            my $end = $base + 200;

            $end = $num if ( $end > $num );

            $svn->SvnCmd ( 'delete', map ("$opt_workdir/$_", @rm_files[$base .. $end] ),

                            { 'error' => 'Deleting files from workspace' } );

            $base = $end + 1;

        }

    }

    #

    #   The common files may have changed

    #   Simply copy them all in and let subversion figure it out

    #

    foreach my $file ( sort keys %common  )

    {

        my $src = "$opt_dir/$file";

        my $target = "$opt_workdir/$file";

        next if ( -d $src );

        if ( File::Compare::compare ($src, $target) )

        {

            Verbose ("Transfer $file");

            unlink $target;

            unless (File::Copy::copy( $src, $target ))

            {

                Error("Failed to transfer file [$file]: $!",

                      "Src: $src",

                      "Tgt: $target");

            }

        }

    }

    #

    #   Commit the workspace

    #   This will go back onto the trunk

    #

    $svn = NewSessionByWS( $opt_workdir );

    $svn->SvnCi ('comment' => "Checkin by Svn Import" );

    Message ("Repository Ref: " . $svn->RmRef);

    #

    #   Label the result

    #   The workspace will have been updated, so we can use it as the base for

    #   the labeling process

    #

    if ( $opt_label )

    {

        $svn->SvnCopyWs (

                       target => $url_label,

                       'noswitch' => 1,

                       'replace' => $opt_replace,

                       'comment' => 'Created by Jats Svn Import',

                       );

        Message ("Repository Ref: " . $svn->RmRef);

    }

    #

    #   Clean up

    #

    if ( $opt_delete && ! $opt_reuse )

    {

        Message ("Delete Workspace");

        rmtree( $opt_workdir );

    }

    $opr_done = 1;

}

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

# Function        : SubCommandHelp

#

# Description     : Provide help on a subcommand

#

# Inputs          : $help_level             - Help Level 1,2,3

#                   $topic                  - Topic Name

#

# Returns         : This function does not return

#

sub SubCommandHelp

{

    my ($help_level, $topic) = @_;

    my @sections;

    #

    #   Spell out the section we want to display

    #

    #   Note:

    #   Due to bug in pod2usage can't use 'head1' by itself

    #   Each one needs a subsection.

    #

    push @sections, qw( NAME SYNOPSIS ) ;

    push @sections, qw( ARGUMENTS OPTIONS ) if ( $help_level > 1 );

    push @sections, qw( DESCRIPTION )       if ( $help_level > 2 );

    #

    #   Extract section from the POD

    #

    pod2usage({-verbose => 99,

               -noperldoc => 1,

               -sections => $topic . '/' . join('|', @sections) } );

}

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

#   Documentation

#   NOTE

#

#   Each subcommand MUST have

#   head1 section as used by the subcommand

#       This should be empty, as the contents will NOT be displayed

#   head2 sections called

#       NAME SYNOPSIS ARGUMENTS OPTIONS DESCRIPTION

#

#=head1 xxxxxx

#=head2 NAME

#=head2 SYNOPSIS

#=head2 ARGUMENTS

#=head2 OPTIONS

#=head2 DESCRIPTION

#

=pod

=for htmltoc    GENERAL::Subversion::

=head1 NAME

jats svn - Miscellaneous SubVersion Operations

=head1 SYNOPSIS

jats svn [options] command [command options]

 Options:

    -help[=n]              - Help message, [n=1,2,3]

    -man                   - Full documentation [-help=3]

    -verbose[=n]           - Verbose command operation

 Common Command Options:

    All command support suboptions to provide command specific help

    -help[=n]              - Help message, [n=1,2,3]

    -man                   - Full documentation [-help=3]

 Commands are:

    test                   - Test access to subversion

    ls URL                 - List Repo contents for URL

    delete-package URL     - Delete Package Subtree

    create URL             - Create a new package at URL

    import URL             - Import files to package at URL

 Use the command

    jats svn command -h

 for command specific help

=head1 OPTIONS

=over

=item B<-help[=n]>

Print a help message and exit. The level of help may be either 1, 2 or

3 for a full manual.

This option may be specified multiple times to increment the help level, or

the help level may be directly specified as a number.

=item B<-man>

This is the same as '-help=3'.

The complete help is produced in a man page format.

=item B<--verbose[=n]>

This option will increase the level of verbosity of the commands.

If an argument is provided, then it will be used to set the level, otherwise the

existing level will be incremented. This option may be specified multiple times.

=back

=head1 DESCRIPTION

This program provides a number of useful Subversion based operations.

=head1 Test Subversion

=head2 NAME

Test Subversion

=head2 SYNOPSIS

    jats svn test

=head2 DESCRIPTION

This command will ensure that the subversion command line utility can be

located. The command will report the version of the svn client found.

=head1 List Repository

=head2 NAME

List Repository

=head2 SYNOPSIS

    jats svn ls <URL>

=head2 DESCRIPTION

This command will take a URL and perform a 'svn' list operation. The URL will

be expanded to include the site specific repository.

=head1 Delete a Package

=head2 NAME

Delete a Package

=head2 SYNOPSIS

jats svn delete-package URL [options]

 Options:

    -help[=n]              - Help message, [n=1,2,3]

    -man                   - Full documentation [-help=3]

    -verbose[=n]           - Verbose command operation

=head2 ARGUMENTS

The command takes one argument: The URL of the desired package.

This may be be:

=over

=item * A full URL

Complete with protocol and path information.

=item * A simple URL

JATS will prepend the site-specific repository location to the user provided URL

=back

=head2 OPTIONS

This command has no significant options, other than the general help options.

=head2 DESCRIPTION

This command will delete a package from the repository. It will ensure

that the package is a valid package, before it is deleted.

The command is intended to be used by test scripts, rather than users.

=head1 Create a Package Version

=head2 NAME

Create a Package Version

=head2 SYNOPSIS

jats svn [options] create URL [command options]

 Options:

    -help[=n]               - Help message, [n=1,2,3]

    -man                    - Full documentation [-help=3]

    -verbose[=n]            - Verbose command operation

 Command Options

    -help[=n]               - Provide command specific help

    -import=nnn             - Import directory tree

    -label=nnn              - Label it (trunk import only)

    -new                    - Package must not exist

    -replace                - Replace any existing versions

    -trunk                  - Import to trunk

    -tags=nnn               - Import to tags

    -branch=nnn             - Import to branches

=head2 ARGUMENTS

The command takes one argument: The URL of the desired package.

This may be be:

=over

=item * A full URL

Complete with protocol and path information.

=item * A simple URL

JATS will prepend the site-specific repository location to the user provided URL

=back

=head2 OPTIONS

=over

=item -help[=n]

Print a help message and exit. The level of help may be either 1, 2 or 3.

This option may be specified multiple times to increment the help level, or

the help level may be directly specified as a number.

=item -import=nnn

This option specifies the path of a subdirectory tree to import into the newly

created package. In not provided, then only a package skeleton will be created.

=item -label=nnn

This option specifies a label to place the imported source, if the source is

being imported to the 'trunk' of the package.

=item -new

This option specifies that the named package MUST not exist at all.

=item -replace

This option allows the program to replace any existing versions of the

imported source. It will allow the deletion of any existing trunk, tags or

branches.

=item -trunk

This option specifies that imported source will be placed on the trunk of the

package. This is the default mode of import.

The options -trunk, -tags and -branch are mutually exclusive.

=item -tags=nnn

This option specifies that imported source will be placed directly on the

named tag of the package.

The options -trunk, -tags and -branch are mutually exclusive.

=item -branch=nnn

This option specifies that imported source will be placed directly on the

named branch of the package.

The options -trunk, -tags and -branch are mutually exclusive.

=back

=head2 DESCRIPTION

This command will create a new package within a repository. It will ensure

that the package contains the three required subdirectories: trunk, tags and

branches.

The command will also ensure that packages are not placed at inappropriate

locations within the repository. It is not correct to place a package within

another package.

The command will, optionally, import a directory tree into the repository and,

optionally, label the package.

The package body may be imported to the 'trunk' or to a branch or a tag.

By default the data will be imported to the trunk and may be labeled (tagged).

Options allow the targets to be deleted if they exist or to ensure that they

are not present.

The command does not attempt to merge file versions within the repository. It

may result in multiple instances of a file within the repository. Use only for

simple imports. Use the 'import' command for more sophisticated import requirements.

=head1 Import directory to a Package

=head2 NAME

Import directory to a Package

=head2 SYNOPSIS

jats svn [options] import URL [command options]

 Options:

    -help[=n]               - Help message, [n=1,2,3]

    -man                    - Full documentation [-help=3]

    -verbose[=n]            - Verbose command operation

 Command Options

    -help[=n]               - Command specific help, [n=1,2,3]

    -verbose[=n]            - Verbose operation

    -package=name           - Name of source package

    -dir=path               - Path to new version

    -label                  - Label the result

    -replace                - Allow the label to be replaced

    -reuse                  - Reuse the import directory

    -workspace=path         - Path and name of alternate workspace

    -[no]delete             - Deletes workspace after use. Default:yes

=head2 ARGUMENTS

The command takes one argument: The URL of the desired package.

This may be be:

=over

=item * A full URL

Complete with protocol and path information.

=item * A simple URL

JATS will prepend the site-specific repository location to the user provided URL

=back

=head2 OPTIONS

=over

=item -help[=n]

Print a help message and exit. The level of help may be either 1, 2 or 3.

This option may be specified multiple times to increment the help level, or

the help level may be directly specified as a number.

=item -verbose[=n]

This option will increase the level of verbosity of the utility.

If an argument is provided, then it will be used to set the level, otherwise the

existing level will be incremented. This option may be specified multiple times.

=item -package=name

Either this option or a bare URL on the command line must be provided. It

specifies the repository and package to be used as a basis for the work.

=item -dir=path

This option is mandatory. It specifies the path to a local directory that

contains a version of the software to be checked in.

=item -label=name

The resulting software version will be labeled with this tag, if it is provided.

=item -replace

This option, if provided, allows the label to be replaced.

=item -reuse

This option can be used to speed the creation of multiple versions in a scripted

environment. The option allows the utility to reuse the workspace if it exists.

=item -workspace=path

This option specifies an alternate workspace directory to create and use. The

default directory is "SvnImportDir" within the users current directory.

=item [no]delete

This option control the deletion of the workspace directory. By default the