Rev 6177 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### COPYRIGHT - VIX IP PTY LTD ("VIX"). 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 FileUtils;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;my $opt_author;my $opt_date;my $opt_complexTag;my $opt_noUpdateCheck;## 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'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#InitFileUtils();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];## Process user label specification# May in the form SVN::Path::Tag#$label =~ s~^SVN::~~ if $label;if ( $label =~ m~(.+)::(.+)~ ){my $sourcePath = $1;my $tag = $2;## Sanity test of sourcePath#Error ("Invalid use of a peg: $label")if ( $sourcePath =~ m~\@\d+$~ );## Remove anything after a ttb (truck, tags, branch) element# This will be the root of the package within the repo#if ( $sourcePath =~ m~(.*)/((tags|branches|trunk)(/|$)(.*))~ ){Error ("Source Path has insufficient items")if ( $1 eq '' );Error ("SourcePath contains invalid items after '$3': '$5'")if ( ($3 eq 'tags' || $3 eq 'trunk') && $5 ne '' );Error ("SourcePath must contain items after 'branches'")if ( $3 eq 'branches' && $5 eq '');$label = $1 . '/tags/' . $tag;}else{Error ("Source Path does not contain tags or trunk or branches component");}Verbose ("Tag: $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:' . $label),);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/~ ){my $tag = $label;$tag = 'tags/' . $tag unless ( $tag =~ m~^tags/~ );$ws_label_old = $session->backTrackSvnLabel( $tag, 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 );## If operation is 'label', then we have a Workspace# Ensure that we are in the 'root' of the workspace - otherwise we will get cryptic messages#if ( $opt_label && $ws_root && !$opt_workspace) {my $pathToRoot = RelPath($ws_root);if ( $pathToRoot =~ m~^..~) {Warning("Current directory is the not the workspace root","The 'svn update' command will not update the entire workspace");}}## 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 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 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 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 - 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 reportedif the label exists.=item B<-check>This option will check for the labels 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<-auto>This option is the same as '-label'. It is provided for compatibility with otherlabeling tools.=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 labels 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 packages 'branches' area instead of the default 'tags'area.=item -author=nameThis 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=dateStringThis 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.921324ZThis option may not work for non-admin users.=item -allowLocalModsThis option modifies the checking that is done when the workspace is labeled.The default is to 'not' allow local modifications. All modifications must becommitted before the label is created.If local modifications are allowed, then the utility will warn about localmodifications, but the labelling process will continue. This allowsfor 'complex' tagging. The modified files will be transferred to the repositoryand will form a part of the tag.This mode of operation should NOT be used for normal labeling. It is useful forthe preservation of 'Mixed Workspaces'.=item -allowRepoChangesThis 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 thedevelopment branch.If Repository Changes are allowed, then the utility will warn about changes, butthe labelling process will continue. This allows Workspaces that have beenpegged to old versions to be tagged.The Repository may still reject the tag if the workspace has been modified ina manner that would result in a client-side copy. This is intentional.=back=head1 DESCRIPTIONThis program provides a number of useful Subversion labeling operations. Theseare:=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=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 proceeding 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.A simple label of TIMESTAMP will be treated in special manner. The name will bereplaced with a unique name based on the users name and the current date time.=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