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 JatsProperties;

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;

use Encode;

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 options 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/ );

DeleteBranch()                         if ( $cmd =~ m/^delete-branch/ );

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

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

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

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

ShowPaths()                            if ( $cmd =~ m/^path/ );

ShowTag()                              if ( $cmd =~ m/^tag/ );

ShowUrl()                              if ( $cmd =~ m/^url/ );

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

exit 0;

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

# Function        : ShowPaths

#

# Description     : Show PATHS

#

# Inputs          : 

#

# Returns         : 

#

sub ShowPaths

{

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

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

    #

    #   Subcommand specific help

    #

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

    #

    #   Display known PATHS

    #

    my ( $pSVN_URLS, $pSVN_URLS_LIST) = SvnPaths();

    print ("Configured SubVersion Repository Paths\n");

    print sprintf("    %-20s %s\n", 'Tag', 'URL Prefix');

    foreach my $key ( @{$pSVN_URLS_LIST} )

    {

        print sprintf("    %-20s %s\n", $key || 'Default', $pSVN_URLS->{$key} );

    }

    $opr_done = 1;

}

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

# Function        : ShowTag

#

# Description     : Convert a URL into a TAG

#                   Convert the current workspace info into a TAG

#

# Inputs          : url                     - Url to convert (optional)

#                   Options

#                       -help[=n]           - Show help

#                       -man                - Show manual

#                       -url=url            - Convert URL

#                       -path=path          - Convert Workspace

#

# Returns         : Nothing

#

sub ShowTag

{

    my $opt_path;

    my $opt_url;

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "path:s"        => \$opt_path,

                "url:s"         => \$opt_url,

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

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Url to Tag") if ($opt_help);

    #

    #   Bare argument is a URL

    #   If no arguments provided assume a path of the current directory

    #

    $opt_url = shift (@ARGV) if ( $#ARGV == 0 );

    $opt_path = '.' unless ( defined $opt_path || defined $opt_url );

    #

    #   Sanity Tests

    #

    Error ("Cannot specify both a URL and a PATH")

            if ( defined $opt_url && defined $opt_path );

    Warning ("Too many arguments") if ( $#ARGV >= 0 );

    #   Do all the hard work

    #

    my $uref;

    if ( $opt_url )

    {

        $uref = NewSessionByUrl ( $opt_url );

        $uref->CalcRmReference($uref->Full());

    }

    else

    {

        $uref = NewSessionByWS($opt_path, 0, 1);

        my $ws_root = $uref->SvnLocateWsRoot(1);

        $uref->CalcRmReference($uref->FullWs());

    }

    Message ("Tag is: " . $uref->RmRef() );

    $opr_done = 1;

}

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

# Function        : ShowUrl

#

# Description     : Convert a TAG into a URL

#                   Show the current workspace URL

#

# Inputs          : tag                     - Tag to convert (optional)

#                   Options

#                       -help[=n]           - Show help

#                       -man                - Show manual

#                       -tag=tag            - Convert TAG

#                       -path=path          - Convert Workspace

#

# Returns         : Nothing

#

sub ShowUrl

{

    my $opt_path;

    my $opt_tag;

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "path:s"        => \$opt_path,

                "tag:s"         => \$opt_tag,

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

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Tag to Url") if ($opt_help);

    #

    #   Bare argument is a TAG

    #   If no arguments provided assume a path of the current directory

    #

    $opt_tag = shift (@ARGV) if ( $#ARGV == 0 );

    $opt_path = '.' unless ( defined $opt_path || defined $opt_tag );

    #

    #   Sanity Tests

    #

    Error ("Cannot specify both a TAG and a PATH")

            if ( defined $opt_tag && defined $opt_path );

    Warning ("Too many arguments") if ( $#ARGV >= 0 );

    #   Do all the hard work

    #

    my $uref;

    my $url;

    if ( $opt_tag )

    {

        $url = SvnPath2Url($opt_tag);

    }

    else

    {

        $uref = NewSessionByWS($opt_path, 0, 1);

        my $ws_root = $uref->SvnLocateWsRoot(1);

        $url = $uref->FullWsRev();

    }

    Message ("Url: $url");

    $opr_done = 1;

}

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

# 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

{

    my $opt_error = 0;

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "error!"       => \$opt_error,

                ) || 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(!$opt_error);

    $uref->SvnDelete (

                      'target'      => $uref->Full,

                      'comment'   => [$uref->Path().": Delete Package",'Deleted by user command: jats svn delete-package'],

                      'noerror'   => !$opt_error,

                      );

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

    my $opt_author;

    my $opt_date;

    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,

                "tags=s"        => \$opt_tag,

                "label=s"       => \$opt_label,

                "replace"       => \$opt_replace,

                'author=s'      => \$opt_author,

                'date=s'        => \$opt_date,

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

    #

    #   Subcommand specific help

    #

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

    #

    #   Alter the error reporting parameters

    #

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

    Error ("Too many command line arguments") if ( exists $ARGV[1] );

    $type = 'tags/' . $opt_tag          if ( $opt_tag);

    $type = 'branches/' . $opt_branch   if ( $opt_branch );

    $type = 'trunk'                     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,

                      );

    #

    # Report RmPath as using a pegged version of a new package is a bit silly

    #

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

    Message ("Vcs Tag       : " . $uref->SvnTag);

    if ( $uref->{REVNO} )

    {

        $uref->setRepoProperty('svn:author', $opt_author) if (defined ($opt_author));

        $uref->setRepoProperty('svn:date', $opt_date) if (defined ($opt_date));

    }

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

    my $opt_author;

    my $opt_date;

    my $opt_log = '';

    my $opt_branch;

    my $opt_datafile;

    #

    #   Other globals

    #

    my $url_label;

    my $url_branch;

    #

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

                    'branch=s'      => \$opt_branch,

                    'replace'       => \$opt_replace,

                    'reuse'         => \$opt_reuse,

                    'workspace=s'   => \$opt_workdir,

                    'delete!'       => \$opt_delete,

                    'author=s'      => \$opt_author,

                    'date=s'        => \$opt_date,

                    'log=s'         => \$opt_log,

                    'datafile=s'    => \$opt_datafile,

                    #

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

    unlink $opt_datafile if ( defined $opt_datafile );

    #

    #   Subcommand specific help

    #

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

        if ($opt_help || ! $opt_package );

    #

    #   Alter the error reporting parameters

    #

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

    }

    #

    #   Validate the required branch

    #   It will be created if it doesn't exist

    #

    if ( $opt_branch )

    {

        $opt_branch = SvnIsaSimpleLabel($opt_branch);

        $url_branch = $svn->BranchName( $opt_branch, 'branches' );

        my $rv = $svn->SvnValidateTarget (

                        'cmd'    => 'SvnImporter. Create branch',

                        'target' => $url_branch,

                        'create' => 1,

                        );

        if ( $rv == 2 )

        {

            $svn->setRepoProperty('svn:author', $opt_author) if (defined ($opt_author));

            $svn->setRepoProperty('svn:date', $opt_date) if (defined ($opt_date));

        }

    }

    #

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

                            );

        my $url_co = $opt_branch ? $url_branch : $svn->Full . '/trunk';

        $svn->SvnCo ( $url_co, $opt_workdir, $opt_verbose ? '--Print' : '--NoPrint' );

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

    #

    #   Scan for a source file

    #   Trying to detect empty views

    #   Look for file, not directory

    #

    {

        my $fileFound = 0;

        foreach ( @dir )

        {

            next if ( m~/$~ );

            $fileFound++;

            last;

        }

        unless ( $fileFound )

        {

            Warning ("No source files found in source view");

            $opr_done = 1;

            return;

        }

    }

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

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

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

    #Information ("DIR Results:", scalar @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 );

    #

    #   Need to consider the case where a file has been replaced with a directory

    #   and visa-versa. Delete files and directories first.

    #

    #

    #   Remove files

    #   Sort in reverse. This will ensure that we process directory

    #   contents before directories

    #

    my @rm_files = reverse 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 + 1) . " 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;

        }

    }

    #

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

            {

                Verbose ("Adding directory: $file");

                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 " . (1 + $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;

        }

    }

    #

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

    my $pkgPath = $svn->Path();

    my $ciComment = "$pkgPath: Checkin by Svn Import";

    $ciComment .= "\n" . $opt_log if ( $opt_log );

    $ciComment =~ s~\r\n~\n~g;

    $ciComment =~ s~\r~\n~g;

    $ciComment = encode('UTF-8', $ciComment, Encode::FB_DEFAULT);

    $svn->SvnCi ('comment' => $ciComment, 'allowSame' => 1 );

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

    $svn->setRepoProperty('svn:author', $opt_author) if (defined ($opt_author));

    $svn->setRepoProperty('svn:date', $opt_date) if (defined ($opt_date));

    #

    #   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' => "$pkgPath: Tagged by Jats Svn Import",

                       );

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

        Message ("Vcs Tag       : " . $svn->SvnTag);

        $svn->setRepoProperty('svn:author', $opt_author) if (defined ($opt_author));

        $svn->setRepoProperty('svn:date', $opt_date) if (defined ($opt_date));

    }

    #

    #   Clean up

    #

    if ( $opt_delete && ! $opt_reuse )

    {

        Message ("Delete Workspace");

        rmtree( $opt_workdir );

    }

    #

    #   Automation data transfer

    #

    if ( defined $opt_datafile )

    {

        my $data = JatsProperties::New();

        $data->setProperty('Command'        , 'ImportPackage');

        $data->setProperty('Label'          , $opt_label);

        $data->setProperty('subversion.url' , $svn->RmRef);

        $data->setProperty('subversion.tag' , $svn->SvnTag);

        $data->Dump('InfoFile') if ($opt_verbose);

        $data->store( $opt_datafile );

    }

    $opr_done = 1;

}

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

# Function        : DeleteBranch

#

# Description     : Delete the branch that a workspace is based upon

#

# Inputs          : 

#

# Returns         : 

#

sub DeleteBranch

{

    my $opt_path;

    my $opt_error = 0;

    #

    #   Parse more options

    #

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "path:s"        => \$opt_path,

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

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Delete Branch") if ($opt_help);

    #

    #   Sanity Tests

    #

    Message ("Delete Workspace Branch" );

    Error ("Too many arguments: @ARGV") if ( $#ARGV >= 0 );

    #

    #   Do all the hard work

    #

    $opt_path = '.' unless ( defined $opt_path );

    my $uref = NewSessionByWS($opt_path, 0, 1);

    my $ws_root = $uref->SvnLocateWsRoot(1);

    my $ws_url = $uref->FullWs();

    #

    #   Must be a branch

    #

    Error ("Workspace is not based on a branch")

        unless ( $ws_url =~ m ~/branches/~ );

    Message ("Deleting: " . $uref->{WSURL} );

    $uref->SvnDelete (

                      'target'    => $ws_url,

                      'comment'   => [$uref->Path().": Delete Branch",'Deleted by user command: jats svn delete-branch'],

                      );

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

}

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