Rev 341 | Rev 379 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### 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 supportuse Getopt::Long;use Cwd;my $VERSION = "1.0.0"; # Update this## Options#my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debugmy $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbosemy $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 Sessionmy $label; # User argument - one labelmy $src_label; # User specified source labelmy $pkg_root; # Root of corresponding packagemy $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"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") if ( $opt_clone && $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 ( ($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 )## Inputs : $base# $name## Returns : Full label#sub make_src_label{return $src_label if ( $src_label );my ($base, $name) = @_;my $join = $opt_branch ? '/branches/' : '/tags/';return $base . $join . $name;}#-------------------------------------------------------------------------------# 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 ( $label && $label =~ m~(.+)(/(tags|branches|trunk)(/|@)(.+))~ ){## Attempt to extract it from the label# 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 NAMEjats_svnlabel - Subversion label operations=head1 SYNOPSISjats 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-list - List lables in a package-rename=xxx - Rename a labelModifiers-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 reportedif the label exists.=item B<-check>This option will check for the lables existence. An error will be reportedif 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<-rename=xxx>This option will rename a label. The new name of the label is provided as theargument after the option. If any further operation are to be performed thenew label name will be used.=item B<-list>This option will case all lables for the related package to be shown. Thecommand 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 tobe 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 determinethe 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 willbe taken to be that of the package in the workspace.=item B<-branch>This option modifies all commands. It causes the labeling operations to beperformed on a the packages 'branches' area instead of the default 'tags'area.=back=head1 DESCRIPTIONThis program provides a number of useful Subversion labeling operations. Theseare:=over 8=item *check - check existance of a label=item *available - check non-existance of a label=item *list - list the label on a package=item *rename - rename a label=item *label - label a workspace=item *delete - delete a label=item *clone - duplicate a label=backThe various operations may be mixed in the one command. The order of theoperations is: check, available, list, rename, label, delete and clone=head2 LABEL formatA 'label' as used by JATS within a Subversion repository, may have four elements.These are:=over=item * Package PathAny text preceeding a / will be taken to be a package path. This identifies theroot of the package within the repository.=item * Label TypeThis will be one of 'trunk', 'branches' or 'tags'.Normally labels are placed on the 'tags' subdirectory of a package.=item * Simple LabelThe label tag. It can only contain Alphanumerics and the characters :-_.In practice this can be a simple version number as the labels are held thecontext of a package.=item * PegA peg consists of a '@' and a number string at the end of the label.=backAn example of a full label is: repo/package/component/tags/label_text@1234Not all operation support the full label syntax. The 'peg' is not allowed ina label that will be used as a target of a repository copy operation, noris the 'Package Path'.Full labels can be used in operations that specify the source of acopy operation, such as a delete, rename or clone operation.All operations report a 'Full Label' that can be used to reference therepository at any time in the future. This is the 'tag' that needs to beprovided to 'Release Manager in order to reproduce the package.=head1 EXAMPLEjats svnlabel -label daf_br_23.0.0.syd=cut