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' );

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

exit 0;

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

# 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

#                   Optionall 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

#                       -new            - Must be new package

#

# 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 = "ImportDir";

    #

    #   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"     => \$opt_workdir,

                    #

                    #   Update documentation at the end of the file

                    #

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

    #

    #   Insert defaults

    #   User can specify base package via -package or unoptions arguments

    #

    $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 );

    }

    #

    #   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\$",

                                       );

    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

        #

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

        $svn->SvnCmd ( 'add'

                        , '--depth=empty'

                        , '--parents'

                        , map ("$opt_workdir/$_", @added),

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

    }

    #

    #   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

        #

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

        $svn->SvnCmd ( 'delete', map ("$opt_workdir/$_", @rm_files ),

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

    }

    #

    #   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);

    }

    $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) = @_;

    #

    #   Spell out the section we want to display

    #

    #   Note:

    #   Due to bug in pod2usage cant use 'head1' by itself

    #   Each one needs a subsection.

    #

    my $help_re;

    my @sections;

    if ( $help_level <= 1 ) {

        @sections = qw( NAME SYNOPSIS );

    } elsif ( $help_level <= 2 ) {

        @sections = qw( NAME SYNOPSIS ARGUMENTS OPTIONS );

    } else {

        @sections = qw( NAME SYNOPSIS ARGUMENTS OPTIONS DESCRIPTION );

    };

    #

    #   Build up a topic list

    #

    $help_re .= $topic . '\/' . $_ . '|' foreach ( @sections );

    #

    #   Extract section from the POD

    #   Need trailling DUMMY to overcome BUG in pod2usage

    #

    pod2usage({-verbose => 99,

               -sections => $help_re . 'DUMMY'} );

}

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

#   Documentation

#   NOTE

#

#   Each subcommand MUST have

#   head1 section as used by the subcommand

#       This should be empty

#   head2 sections called

#       NAME SYNOPSIS ARGUMENTS OPTIONS DESCRIPTION

#

#=head1 xxxxxx

#=head2 NAME

#=head2 SYNOPSIS

#=head2 ARGUMENTS

#=head2 OPTIONS

#=head2 DESCRIPTION

#

=pod

=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:

    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 List Repository

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 desirecd 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 comand 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 desirecd 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 specifes 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, trags 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 mutally exclusive.

=item -tags=nnn

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

named tag of ther package.

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

=item -branch=nnn

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

named branch of ther package.

The options -trunk, -tags and -branch are mutally 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 labled (tagged).

Options allow the targets to be deleletd 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.

=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

=head2 ARGUMENTS

The command takes one argument: The URL of the desirecd 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

This option is mandatory. 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 labled 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 -workpspace=path

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

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

=back

=head2 DESCRIPTION

Import a new version of a package to the trunk of the package. The utility

will only import changed files so that file history is preserved within the

repository.

This utility is used import software from another version control system

The utility will:

=over

=item * Create a Work Space based on the current pakage version

The 'trunk' of the named package will be used as the baes for the workspace.

=item * Update files and directories

Determines the files and directories that have been added and deleted and

update the Workspace to reflect the new structure.

=item * Check in the new version

=item * Label the new version

=back

=cut