Subversion Repositories DevTools

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

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

#

# Module name   : jats_svnlabel.pl

# Module type   : Jats Utility

# Compiler(s)   : Perl

# Environment(s): Jats

#

# Description   : A script to perform a number of labeling operations

#                 The script will:

#                   label a workspace       - Create a tag

#                   delete a label          - Deletes a tag

#                   rename a label          - Renames a tag

#                   clone a label           - Clones a tag

#

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

require 5.006_001;

use strict;

use warnings;

use JatsError;

use JatsSvn;

use Pod::Usage;                             # required for help support

use Getopt::Long;

use Cwd;

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;

my $opt_check;

my $opt_avail;

my $opt_label;

my $opt_replace;

my $opt_delete;

my $opt_rename;

my $opt_clone;

my $opt_comment;

my $opt_workspace;

my $opt_packagebase;

my $opt_branch;

my $opt_list;

#

#   Globals

#

my $session;                                # Subversion Session

my $label;                                  # User argument - one label

my $src_label;                              # User specified source label

my $pkg_root;                               # Root of corresponding package

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

                "check"         => \$opt_check,             # Flag

                "available"     => \$opt_avail,             # Flag

                "label"         => \$opt_label,             # Flag

                "auto"          => \$opt_label,             # Same as -label

                "delete"        => \$opt_delete,            # Flag

                "replace!"      => \$opt_replace,           # Flag

                "rename=s"      => \$opt_rename,            # String

                "clone=s"       => \$opt_clone,             # String

                "comment=s"     => \$opt_comment,           # String

                "workspace=s"   => \$opt_workspace,         # String

                "packagebase=s" => \$opt_packagebase,       # String

                "branch"        => \$opt_branch,            # Flag

                "list"          => \$opt_list,              # Flag

                );

                #

                #   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'    =>'SVNLABEL',

             'verbose' => $opt_verbose,

            );

#

#   Validate user options

#   Need one command line argument

#

Error ("No labels provided") if ( $#ARGV < 0 && !$opt_list );

Error ("Too many labels provided") if ( $#ARGV > 0);

Error ("Conflicting options. Clone and Label") if ( $opt_clone && $opt_label );

Error ("Conflicting options. Rename and Label") if ( $opt_rename && $opt_label );

$label = $ARGV[0];

#

#   Locate package and workspace roots

#

LocateRoots ();

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

#

#   Validate one or more labels

#   Intended to be used within scripts for testing

#

if ( $opt_check )

{

    $session->SvnValidateTarget

    (

        'target'    => make_src_label ($pkg_root, $label),

        'cmd'       => 'Validate Existence',

        'require'   => 1,

    );

    $opr_done = 1;

}

if ( $opt_avail )

{

    $session->SvnValidateTarget

    (

        'target'    => make_src_label ($pkg_root, $label),

        'cmd'       => 'Validate Availablility',

        'available' => 1,

    );

    $opr_done = 1;

}

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

#

#   List labels

#

if ( $opt_list )

{

    my $pList = $session->ListLabels (make_label ($pkg_root, '') );

    #

    #   Remove trailing / on all directory names

    #

    chop @{$pList};

    my $type = $opt_branch ? 'branch' : 'tag';

    Information ( "Package: " . $session->Path,

                    ,map ( $type . ': ' . $_, @{$pList})

                    );

    $opr_done = 1;

}

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

#

#   Rename a label

#   This has implications for stuff that is stored within release manager

#

#   Renaming a pegged version is problematical

#   At the moment we do a copy ( rename, without the delete)

#

if ( $opt_rename )

{

    #

    #   Create old and new paths for the full label

    #

    my $ws_label_old = make_src_label ($pkg_root, $label);

    my $ws_label_new = make_label ($pkg_root ,SvnIsaSimpleLabel($opt_rename));

    $session->SvnRename (

                'old' => $ws_label_old,

                'new' => $ws_label_new,

                'comment' => $opt_comment ? $opt_comment : 'Renamed by Jats Svnlabel',

                'replace' => $opt_replace ? 1 : 0,

                );

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

    $opr_done = 1;

}

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

#   

#   The Svn Label need a package root

#   If we are in a WorkSpace, then we can determine the package root

#

if ( $opt_label )

{

    #

    #   Can now create a nice pathname for the label

    #

    my $ws_label = make_label( $pkg_root, SvnIsaSimpleLabel ($label));

    #

    #   Don't let the user create a tag from a workspace that is

    #   also created from a tag.

    #

    #   They should be using a branch.

    #   Can't stop them - but can make it difficult.

    #

    Error ("Cannot tag a Workspace based on a 'tag'",

           "You should be working in a branch",

           "WorkSpace: $session->{WSURL}" )

        if ( !$opt_branch && (($session->WsType) eq 'tags') );

    $session->SvnCopyWs (

                   target => $ws_label,

                   'noswitch' => 1,

                   'replace' => $opt_replace ? 1 : 0,

                   'comment' => $opt_comment ? $opt_comment : 'Created by Jats Svnlabel',

                   );

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

    $opr_done = 1;

}

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

#

#   Delete a label

#   Can't really delete one, but we can remove it from the head

#   If SVN ever gets an 'obliterate' command then prehaps we could use it

#

if ( $opt_delete )

{

    #

    #   Calculate the label name to delete

    #

    my $ws_label = make_src_label( $pkg_root, $label );

    $session->SvnDelete ( 'target' => $ws_label,

                          'comment' => $opt_comment ? $opt_comment : 'Deleted by Jats Svnlabel',

                          'noerror' => 1 );

    $opr_done = 1;

}

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

#

#   Clone a label

#   Essentially a copy of a tag

#

#

if ( $opt_clone )

{

    #

    #   Create old and new paths for the full label

    #

    my $ws_label_old = make_src_label ($pkg_root, $label);

    my $ws_label_new = make_label ($pkg_root ,SvnIsaSimpleLabel($opt_clone));

    $session->SvnCopy (

                'old' => $ws_label_old,

                'new' => $ws_label_new,

                'comment' => $opt_comment ? $opt_comment : 'Copied by Jats Svnlabel',

                'replace' => $opt_replace ? 1 : 0,

                );

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

    $opr_done = 1;

}

Error ("No valid operations specified. Try -h") unless ( $opr_done );

exit 0;

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

# Function        : make_label

#

# Description     : Create a label ( tag or branch )

#

# Inputs          : $base

#                   $name

#

# Returns         : Full label

#

sub make_label

{

    my ($base, $name) = @_;

    my $join = $opt_branch ? '/branches/' : '/tags/';

    return $base . $join . $name;

}

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

# Function        : make_src_label

#

# Description     : Create a source label ( tag or branch )

#

#                   Calculateion may be bypassed in the global $src_label

#                   is specified.

#

# Inputs          : $base

#                   $name           - May contain hint

#                                     Prefixed with 'tags/' or 'branches/'

#

# Returns         : Full label

#

sub make_src_label

{

    return $src_label if ( $src_label );

    my ($base, $name) = @_;

    my $result = $name;

    unless ( $name =~ m~(^branches/)|(^tags)~ )

    {

        $result = ($opt_branch ? 'branches/' : 'tags/' ) . $name;

    }

    return $base . '/' . $result;

}

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

# Function        : LocateRoots

#

# Description     : Determine workspace root and associated

#                   package root

#

#                   Uses several hint to figure it out

#                       The default is the package in the current directory

#                       -workspace - may address a workspace

#                       -packagebase - may specify a package base

#                                      Does not work with -label

#                                      as we need a workspace

#

#

# Inputs          : None - uses globals

#

# Returns         : Setup global variables

#

sub LocateRoots

{

    #

    #   Use current directory as the workspace unless the user

    #   has specified a different one

    #

    $session = NewSessionByWS( $opt_workspace || '.', $opt_workspace ? 0 : 1 );

    Verbose ("Determine the current workspace root" );

    my $ws_root = $session->SvnLocateWsRoot(1) || '';

    #

    #   Only need a WS root for the label operation

    #   Every thing else can live without it

    #

    Error ("Cannot determine source Workspace") if ( $opt_label && !$ws_root );

    #

    #   Calculate the package base

    #       - User specified

    #       - Extacted from label

    #       - Extracted from WorkSpace

    #           - User specified Workspace

    #           - Current directory

    #

    if ( $opt_packagebase )

    {

        #

        #   User has given us the package base

        #

        $session = NewSessionByUrl ( $opt_packagebase, 0, $session );

        $session->SvnValidatePackageRoot();

    }

    elsif ( (!$opt_label ) && $label && $label =~ m~(.+)(/(tags|branches|trunk)(/|@)(.+))~ )

    {

        #

        #   Attempt to extract it from the label, but only if we are not

        #   labeling a sandbox.

        #   Remove it from the label

        #

        $src_label = $2;

        $label = $5;

        $session = NewSessionByUrl ( $1, 0, $session );

        $session->SvnValidatePackageRoot();

        $src_label = $session->Full . $src_label;

    }

    elsif ( $ws_root )

    {

        # $s2 = $session;

    }

    else

    {

        Error ("Cannot determine the Package Base");

    }

    $pkg_root = $session->Full;

    #

    #   Everything needs a $pkg_root

    #

    Error ("Cannot determine Package Base") unless ( $pkg_root  );

    Verbose ("Workspace root: $ws_root");

    Verbose ("Package root  : $pkg_root");

#DebugDumpData ("Session", $session );

}

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

#   Documentation

#

=pod

=for htmltoc    GENERAL::Subversion::

=head1 NAME

jats_svnlabel - Subversion label operations

=head1 SYNOPSIS

jats svnlabel [options] C<label>

 Options:

    -help                  - brief help message

    -help -help            - Detailed help message

    -man                   - Full documentation

    -available             - Check for label availablility

    -check                 - Check for label existence

    -clone=xxx             - Clone a package version

    -delete                - Delete label from the repository

    -label                 - Labels a Package

    -auto                  - Same as -label

    -list                  - List lables in a package

    -rename=xxx            - Rename a label

 Modifiers

    -branch                - Use branches, not tags

    -replace               - Replace existing labels. Use with -label

    -comment=text          - Comment to add to repository operations

    -workspace=path        - Path to a workspace to label

    -packagebase=path      - Repostory path to package base

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-clone=xxx>

This option will copy a labled version of a package to a new label.

=item B<-delete>

This option will delete the specified label from the repository

=item B<-available>

This option will check for the lables non-existence. An error will be reported

if the label exists.

=item B<-check>

This option will check for the lables existence. An error will be reported

if the label does not exist.

=item B<-label>

This option will label a workspace.

The -replace option may be used to force labels to be moved.

=item B<-auto>

This option is the same as '-label'. It is provided for compatibility with other

labeling tools.

=item B<-rename=xxx>

This option will rename a label. The new name of the label is provided as the

argument after the option. If any further operation are to be performed the

new label name will be used.

=item B<-list>

This option will case all lables for the related package to be shown. The

command assumes that the repository is in a trunk/tags/branches format.

By default tags are shown. Branches may be shown with the -branches option.

=item B<-replace>

This option may be used with the -label command to allow existing labels to

be replaced.

=item B<-comment=text>

This option provides text to be used to document the operation in the log.

If none is provided, then the utility will use a simple comment of its own.

=item B<-workspace=path>

This option can be used to specify the path to a workspace to be labeled.

If not provided then the utility will use the current directory to determine

the root of the workspace.

=item B<packagebase=path>

This option can be used to specify the path to a package within a repository.

If the 'label' contains a package base, then it will be extracted and used.

If not provided and the utility is within a workspace, then the package base will

be taken to be that of the package in the workspace.

=item B<-branch>

This option modifies all commands. It causes the labeling operations to be

performed on a the packages 'branches' area instead of the default 'tags'

area.

=back

=head1 DESCRIPTION

This program provides a number of useful Subversion labeling operations. These

are:

=over 8

=item   *

check - check existance of a label

=item   *

available - check non-existance of a label

=item   *

list - list the labels on a package

=item   *

rename - rename a label

=item   *

label - label a workspace

=item   *

delete - delete a label

=item   *

clone - duplicate a label

=back

The various operations may be mixed in the one command. The order of the

operations is: check, available, list, rename, label, delete and clone

=head2 LABEL format

A 'label' as used by JATS within a Subversion repository, may have four elements.

These are:

=over

=item   * Package Path

Any text preceeding a / will be taken to be a package path. This identifies the

root of the package within the repository.

=item   * Label Type

This will be one of 'trunk', 'branches' or 'tags'.

Normally labels are placed on the 'tags' subdirectory of a package.

=item   * Simple Label

The label tag. It can only contain Alphanumerics and the characters :-_.

In practice this can be a simple version number as the labels are held the

context of a package.

A simple label of TIMESTAMP will be treated in special manner. The name will be

replaced with a unique name based on the users name and the current date time.

=item   * Peg

A peg consists of a '@' and a number string at the end of the label.

=back

An example of a full label is: repo/package/component/tags/label_text@1234

Not all operation support the full label syntax. The 'peg' is not allowed in

a label that will be used as a target of a repository copy operation, nor

is the 'Package Path'.

Full labels can be used in operations that specify the source of a

copy operation, such as a delete, rename or clone operation.

All operations report a 'Full Label' that can be used to reference the

repository at any time in the future. This is the 'tag' that needs to be

provided to 'Release Manager in order to reproduce the package.

=head1 EXAMPLE

jats svnlabel -label daf_br_23.0.0.syd

=cut