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;

my $opt_author;

my $opt_date;

my $opt_complexTag;

my $opt_noUpdateCheck;

#

#   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

                'author=s'      => \$opt_author,            # String

                'date=s'        => \$opt_date,              # String

                'allowlocalmods!'   => \$opt_complexTag,    # [no]aaaaaa

                'allowRepoChanges!'   => \$opt_noUpdateCheck, # [no]aaaaaa

                );

                #

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

$label =~ s~^SVN::~~ if $label;

#

#   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 $label_new = SvnIsaSimpleLabel($opt_rename);

    my $ws_label_new = make_label ($pkg_root , $label_new);

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

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

    updateProperties();

    $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

    #

    $label = SvnIsaSimpleLabel ($label);

    my $ws_label = make_label( $pkg_root, $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') );

    #

    #   The label operation *should* be a server side operation only

    #   If the user has commited changes, but not yet updated the local

    #   workspace, then subversion will do a client side copy

    #   This is not good.

    #       If the 'tags' area is not writable then we get a cryptic message

    #       If the 'tags' area is writable then we commit the changes twice

    #

    #   Solution - ensure that the Workspace is upto date

    #              This is done within SvnCopyWs

    #

    $session->SvnCopyWs (

                   target => $ws_label,

                   'allowLocalMods' => $opt_complexTag,

                   'noupdatecheck' => $opt_noUpdateCheck,

                   'noswitch' => 1,

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

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

                   );

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

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

    updateProperties();

    $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' => 0 );

    $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 $new_label = SvnIsaSimpleLabel($opt_clone);

    my $ws_label_new = make_label ($pkg_root , $new_label);

    #

    #   Backtrack label so that we clone the tag source, not the tag

    #

    if ( $ws_label_old =~ m~/tags/~ )

    {

        $ws_label_old = $session->backTrackSvnLabel( 'tags/' . $label, savedevbranch => 1);

        Verbose2 ("Tag back tracked to: $ws_label_old");

        $ws_label_old = $pkg_root . '/' . $ws_label_old;

    }

    $session->SvnCopy (

                'old' => $ws_label_old,

                'new' => $ws_label_new,

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

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

                );

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

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

    updateProperties();

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

#

#                   Calculation may be bypassed if 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)|(^trunk\@)~ )

    {

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

}

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

# Function        : updateProperties

#

# Description     : Update the properties, if present

#

# Inputs          : Globals

#

# Returns         : Nothing

#

sub updateProperties

{

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

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

}

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

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

    -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 labels 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      - Repository path to package base

    -author=name           - Force author of changes

    -date=dateString       - Force date of changes

    -allowLocalMods        - Allow complex tagging

    -allowRepoChanges      - Supress check for an up to date workspace

=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 labeled 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 labels non-existence. An error will be reported

if the label exists.

=item B<-check>

This option will check for the labels 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 labels 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 packages 'branches' area instead of the default 'tags'

area.

=item -author=name

This option will force the author of changes as recorded in the repository.

The repository must be configured to allow such changes.

This option may not work for non-admin users.

=item -date=dateString

This option will force the date of the changes as recorded in the repository.

The repository must be configured to allow such changes.

The dateString is in a restricted ISO 8601 format: ie 2009-02-12T00:44:04.921324Z

This option may not work for non-admin users.

=item -allowLocalMods

This option modifies the checking that is done when the workspace is labeled.

The default is to 'not' allow local modifications. All modifications must be

committed before the label is created.

If local modifications are allowed, then the utility will warn about local

modifications, but the labelling process will continue. This allows

for 'complex' tagging. The modified files will be transferred to the repository

and will form a part of the tag.

This mode of operation should NOT be used for normal labeling. It is useful for

the preservation of 'Mixed Workspaces'.

=item -allowRepoChanges

This option modifies the checking that is done when the workspace is labeled.

The default is to 'not' allow changes between the Workspace and the Repository.

Normally the Workspace must be up to date with respect to the head of the

development branch.

If Repository Changes are allowed, then the utility will warn about changes, but

the labelling process will continue. This allows Workspaces that have been

pegged to old versions to be tagged.

The Repository may still reject the tag if the workspace has been modified in

a manner that would result in a client-side copy. This is intentional.

=back

=head1 DESCRIPTION

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

are:

=over 8

=item   *

check - check existence of a label

=item   *

available - check non-existence 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 proceeding 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