Subversion Repositories DevTools

########################################################################
# Copyright (C) 1998-2012 Vix Technology, All rights reserved
#
# Module name   : jats_svnrelease.pl
# Module type   : Jats Utility
# Compiler(s)   : Perl
# Environment(s): Jats
#
# Description   : A script to build a package from a SubVersion
#                 The script will:
#                   Create a workspace
#                   Checkout the files
#                   Locate the build file
#                   Build the packages
#                   Install packages
#                   Remove the view
#
#               The script can do a lot of other things too.
#
#               Defined exit code for automation
#                   10 - No files in extracted view
#                        Root directory not found
#                   11 - Label not found
#                   1  - Everything else
#
# Notes         : A lot of this code is common to jats_ccrelease.pl
#                 Will need to refactor if both are to be used
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsSystem;
use FileUtils;
use JatsBuildFiles;
use ArrayHashUtils;
use JatsSvn;

use Pod::Usage;                             # required for help support
use Getopt::Long;
use File::Find;
use File::Copy;
use File::Path;
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;                           # User help level
my @opt_spec;                               # Labels used as a base for the view
my $opt_dpkg = 1;                           # Transfer built package to dpkg_archive
my $opt_copy = 0;                           # Copy built package to user
my $opt_reuse = 0;                          # Re-user view if it exists
my $opt_viewname;                           # View Name
my $opt_extract = 0;                        # Just create a static view
my $opt_extract_files;                      # Just extract files to user - no view
my $opt_devModeStr;                         # Development mode string
my $opt_devMode = '';                       # Development mode (cleaned up)
my $opt_delete = 0;                         # Just delete the view. 2 to force
my @opt_build;                              # build files to use (kludge)
my $opt_test;                               # Test the build process - no copy
my $opt_cache;                              # Cache external packages
my $opt_keep = 0;                           # Keep view if successful
my $opt_beta;                               # Create beta release
my $opt_merge;                              # Merge release
my $opt_path;                               # Path for view spec
my $opt_runtests = 1;                       # Run unit tests after build
my $opt_branch;                             # Create config spec with branch
my $opt_mkbranch;                           # Create branch
my $opt_debug_build = 0;                    # Build Debug Only
my $opt_prod_build = 0;                     # Build ion Only
my $opt_view_root = $ENV{'GBE_VIEWBASE'};   # Root of the view
my $opt_prefix = 1;                         # Prefix the view tag with user-name
my $opt_tag;                                # View tag insert (build or export or user)
my $bad_label_name = 0;                     # Badly formed label
my $opt_escrow = 0;                         # Escrow Mode

#
#   Globals - Provided by the JATS environment
#
my $USER            = $ENV{'USER'};
my $UNIX            = $ENV{'GBE_UNIX'};
my $GBE_SANDBOX     = $ENV{'GBE_SANDBOX'};
my $GBE_ABT         = $ENV{'GBE_ABT'} || '0';
my $MACHINENAME     = $ENV{'GBE_HOSTNAME'};
my $GBE_VIEWBASE    = $ENV{'GBE_VIEWBASE'};   # Root of the view

#
#   Globals
#
my $VIEWDIR_ROOT;                           # Root of the static view
my $VIEWDIR;                                # Absolute path to the view
my $VIEWPATH;                               # Path relative to clearcase
my $view_prefix     = "${USER}_";           # Default WorkSpace prefix
my $user_cwd;                               # Initial User Directory
my $error = 0;                              # Build Error Flag/Counter
my $label_count = 0;                        # Number of labels to create the view
my @label_not_pegged;                       # List of unpegged labels
my @messageText;                            # Messages to be displayed AFTER extraction
my $workSpace;                              # Path to created workspace (or extact)
my $svnSession;                             # Primary Subversion Session
my $noReleaseWs = 0;                        # Do not officially release from this
my $checkDelta = 1;                         # Check Diffs between Tag and Head
                                            #   0 - Don't do anything
                                            #   1 - Warn about diffs
                                            #   2 - Error if diffs
my $traceBack = 2;                          # Trace Back error control. As above
my $needDevBranch = 1;                      # DevBranch error control. As above

#
#   Data about the package-version
#
my $srcPathPkg;                             # Root of the package
my $devBranch;                              # Development Branch - within the package
my $devBranchPeg;                           # May be pegged
my $devBranchHead;                          # Revision of the HEAD of the development branch
my $tagLabel;                               # Label in 'tags'
my $tagPeg;                                 # May be pegged
my $tagLabelBranch;                         # Tagged from this branch: Discovered
my $tagLabelBranchPeg;                      # Tagged from this branch at this peg: Discovered
my $ttbType;                                # trunk, tags or branches
my $urlType;                                # 'jats' or 'url'
my $initialUrl;                             # Initial URL of target

#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     : Main entry point
#
# Inputs          : ARGV[]      - See documentation below
#

#
#   Alter some option defaults if we are creating a view within a sandbox
#
if ( $GBE_SANDBOX )
{
   $GBE_VIEWBASE = $GBE_SANDBOX;
   $opt_prefix = 0;
}

#
#   Parse the user options
#
my $result = GetOptions (
                'help:+'        => \$opt_help,                  # flag, multiple use allowed
                'manual:3'      => \$opt_help,                  # flag
                'v|verbose:+'   => \$opt_verbose,               # flag, multiple use allowed
                'label=s'       => \@opt_spec,                  # Array of build specs
                'view=s'        => \$opt_viewname,              # String
                'dpkg!'         => \$opt_dpkg,                  # [no]flag
                'copy!'         => \$opt_copy,                  # [no]flag
                'reuse!'        => \$opt_reuse,                 # [no]flag
                'extract:+'     => \$opt_extract,               # flag
                'extractfiles'  => \$opt_extract_files,         # flag
                'delete:+'      => \$opt_delete,                # flag
                'build=s'       => \@opt_build,                 # An array of build
                'test!'         => \$opt_test,                  # [no]flag
                'cache'         => \$opt_cache,                 # flag
                'keep!'         => \$opt_keep,                  # [no]flag
                'beta!'         => \$opt_beta,                  # [no]flag
                'merge'         => \$opt_merge,                 # [no]flag
                'path=s'        => \$opt_path,                  # string
                'runtests!'     => \$opt_runtests,              # [no]flag
                'branch=s'      => \$opt_branch,                # String
                'mkbranch=s'    => \$opt_mkbranch,              # String
                'prodOnly'      => \$opt_prod_build,            # flag
                'debugOnly'     => \$opt_debug_build,           # flag
                'root=s'        => \$GBE_VIEWBASE,              # string
                'prefix!'       => \$opt_prefix,                # flag
                'tag=s'         => \$opt_tag,                   # string
                'devMode=s'     => \$opt_devModeStr,            # string
                );

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

InitFileUtils();
#
#   Configure the error reporting process now that we have the user options
#
ErrorConfig( 'name'    => 'SVNRELEASE',
             'verbose' => $opt_verbose );

#
#   Validate user options
#   Use either -label or one command line argument
#
Error ("Cannot mix -extractfiles and -branch")
    if ( $opt_branch && $opt_extract_files );
Error ("Unexpected command line arguments present.","Cannot mix -label and command line label" )
    if ( $#opt_spec >= 0 && $#ARGV >= 0);
Error ("Cannot specify both '-mkbranch' and '-branch'")
    if ( $opt_mkbranch && $opt_branch );

push @opt_spec, @ARGV;

unless(  @opt_spec  )
{
    Error ("Need a workspace or a label. -help for options") if ( $opt_delete  && ! $opt_viewname );
    Error ("Need a Subversion Reference or URL. -help for options") unless $opt_delete;
}

#
#   Set up branching values
#       mkbranch    - Create if not exists. Error if it exists
#       branch      - Error if not exists
#
if ( $opt_mkbranch ) {
    $opt_branch = $opt_mkbranch;
    $opt_mkbranch = 1;
}
$opt_branch = SvnIsaSimpleLabel($opt_branch) if ( $opt_branch );

#   Determine extraction mode
#       Working- Default
#               Extract point on development branch were tag was taken
#               Update build files
#               Warn about files that have changed
#
#       Tag   - Extract point on development branch were tag was taken
#               Update build files
#               Error if tag is not the tip
#
#       Tip   - Extact tip of the development branch
#               Warn about files that have changed between head and tagPoint
#
#       Exact - What the user specified
#               May be a tag and thus not usable
#
if ( $opt_devModeStr )
{
    if ( $opt_devModeStr =~ m/^(Tip)|(BranchTip)$/i) {
        $opt_devMode = 'tip';
        $checkDelta = 1;
        $noReleaseWs = 1;
        $needDevBranch = 2;
    } elsif ( $opt_devModeStr =~ m/^(Tag)|(TagPoint)$/i) {
        $opt_devMode = 'tag';
        $checkDelta = 2;
        $checkDelta = 1 if ( $opt_branch );
        $noReleaseWs = 0;
        $needDevBranch = 2 unless ( $opt_branch );;
    } elsif ( $opt_devModeStr =~ m/^(Work)|(Working)$/i) {
        $opt_devMode = '';
        $checkDelta = 1;
        $noReleaseWs = 0;
    } elsif ( $opt_devModeStr =~ m/^Exact$/i) {
        $opt_devMode = 'exact';
        $checkDelta = 1;
        $noReleaseWs = 0;
        Error ('Cannot mix -[mk]branch and -devMode=' . $opt_devModeStr ) if ( $opt_branch );
    } elsif ( $opt_devModeStr =~ m/^escrow$/i) {
        # JATS internal use only. Not advertised
        $opt_devMode = 'exact';
        $opt_escrow = 1;
        $checkDelta = 0;
        $noReleaseWs = 0;
        $traceBack = 1;
        Error ('Cannot mix -[mk]branch and -devMode=' . $opt_devModeStr ) if ( $opt_branch );
    } else {
        Error ("Unknown development mode: $opt_devModeStr");
    }
}

#
#   The buildtool works in a known environment
#
if ( $GBE_ABT )
{
    $noReleaseWs = 0;       # Can always release
    $checkDelta = 0;        # Do not care. Often expected to have changes.
    $traceBack = 2;         # Must check traceback. Validate RM data
}

#
#   Limit the user to ONE label/tag/
#   Reason: Under Subversion its not possible to 'pinch' files from another
#           package. Don't need to create a workspace with multiple labels
#
#           It was a bad practice under clearcase
#
if ( $#opt_spec >= 1 )
{
    Error ("Multiple labels not supported",
           "Use one label to describe a package" );
}
parseSubversionRef($opt_spec[0]);
Error ("INTERNAL: initialUrl not set") unless ( $initialUrl );
Error ("Cannot interprete the URL or Subversion Reference: $opt_spec[0]") unless ( $srcPathPkg  );

#
#   User has specified both debug and production
#   Then set both to 0 : ie default
#
if ( $opt_debug_build + $opt_prod_build > 1 )
{
    $opt_debug_build = 0;
    $opt_prod_build = 0;
}

#
#   User has requested test mode
#       - Don't copy
#       - Don't package
#
if ( $opt_test )
{
    $opt_dpkg = 0;
    $opt_copy = 0;
}

#
#   Determine the machine type
#
Verbose ("Machine Type: UNIX=$UNIX");

Error ("Machine Name not determined")
    unless ( $MACHINENAME );
$user_cwd = getcwd;

Error ("USER name not determined" )
    unless ( $USER );

#
#   Clean up the view root directory
#
$VIEWDIR_ROOT = Realpath($GBE_VIEWBASE) || $GBE_VIEWBASE;

Verbose ("Viewpath: $VIEWDIR_ROOT");
Error ("Cannot locate view root directory: $VIEWDIR_ROOT" ) unless (-d $VIEWDIR_ROOT);

#
#   Remove any user name from the front of the view name
#   Simplifies the deletion process as the user can provide
#   the directory name
#
$view_prefix = '' unless ( $opt_prefix );

#
#   Create a class to describe the complete SVN label
#   This will parse the label and create a number of nice elements that will
#   be used in determing the name of the workspace
#
$svnSession = NewSessionByUrl ( $initialUrl, 1 );
#DebugDumpData("New Session", $svnSession );

#
#   Test for a pegged label
#
push @label_not_pegged, $svnSession->Full
    unless ( $svnSession->Peg );

#
#   Setup user specified workspace
#   Include the user name to ensure that the view name is unique-ish
#   Keep the name as short as possible as some compilers display a fixed
#   length filename in error messages and this name is part of the path
#
#   Base the viewname on the view label. This will simplify the creation
#   of multiple views and reduce the risk of unexpected deletion
#
$opt_viewname = calcViewName();
$opt_viewname =~ s~^$view_prefix~~ if (defined($opt_viewname) && $view_prefix && $opt_delete );

#
#   Create a clearcase view to be used for the view
#
$VIEWPATH = "$view_prefix$opt_viewname";
$VIEWDIR = "$VIEWDIR_ROOT/$VIEWPATH";
$VIEWDIR =~ tr~\\/~/~s;
Verbose( "Hostname: $MACHINENAME" );
Verbose( "Viewpath: $VIEWPATH" );
Verbose( "Viewdir : $VIEWDIR" );

#
#   If the user has specified a "source path", then we must ensure that it is
#   valid. It will be used to create the WorkSpace
#
#   Ensure that the path is a defined variable. If used prepend a / to simplify
#   concatenation.
#
Verbose("Validate Source Path");
if ( $opt_path )
{
    $opt_path =~ tr~\\/~/~s;
    $opt_path =~ s~/$~~;
    $opt_path =~ s~^/~~;

    Error( "Source Path has drive specifier" ) if ( $opt_path =~ m~^[A-Za-z]\:~ );
    $opt_path = '/'.$opt_path ;
}
else
{
    $opt_path = '';
}
$workSpace = $VIEWDIR . $opt_path;
Verbose( "workSpace : $workSpace" );

#
#   Operation
#   If all we are doing is deleting the view then do it now
#   If we are going to extract stuff, then we will delay the deletion
#   as long as possible - incase we decide we can't
#
if ( $opt_delete )
{
    delete_view()
        unless ( $opt_reuse );
    exit 0;
}

#
#   Ensure that the label is present within the specified Repository
#
Verbose("Ensure Labels can be found in a Repository");
Verbose ("Testing label: ". $svnSession->Full );
$label_count++;

unless ( $svnSession->SvnValidateTarget (
                    'cmd'    => 'SvnRelease',
                    'target' => $svnSession->Full,
                    'test' => 1,
                    )
        )
{
    Error ('ExitCode=11', "SvnRelease: Tag/Reference not found in repository", "Reference: " . $svnSession->Full)
}

#
#   If the user did not provide a peg then examine
#   the 'tag' in the repo and determine when it was created
#   This will not work to well if the user is allowed to move the tag
#
unless ( $svnSession->Peg() )
{
    $svnSession->SvnInfo( $svnSession->Full, 'InfoRepo' );
    my $peg = $svnSession->{'InfoRepo'}{'Last Changed Rev'};

    $svnSession->{'PEG'} = '@' . $peg;
    if ( $tagLabel ) {
        $tagPeg = $peg;
    } elsif ( $devBranch ) {
        $devBranchPeg = $peg;
    }
}
#debugDumpRefInfo('Get Peg');

#
#   Trace back from the tag to the point at which it was copied
#   This should be the same as the user provided development branch
#   but it may not be the same if the user is changing the branch
#
if ( $tagLabel && $traceBack )
{
    my $btData;
    my $labelBranch = $svnSession->backTrackSvnLabel(
                            join ('@', $tagLabel, $tagPeg)
                          , 'data' => \$btData
                          , 'onlysimple' => 0,
                          , 'printdata' => 0 );
    $svnSession->{SavedBackTrack} = $btData;
    unless ( $btData->{isaBranch} )
    {
        my $text = "Cannot trace package label back to a development branch";
        Error ($text) if ( $needDevBranch == 2 );
        Warning ($text);
    }
    else
    {
        Error ("INTERNAL: Cannot parse result of backTrackSvnLabel: $labelBranch")
            unless ($btData->{devBranch} =~ m~^(.*)@(\d+)$~);
        $tagLabelBranch = $1;
        $tagLabelBranchPeg = $2;

        #
        #   Verify that the Development Branch matches that provided by the user
        #
        if ( $devBranch && ($devBranch ne $tagLabelBranch) )
        {
            # If the user is creating a branch, then allow this mismatch
            #
            unless ( $opt_branch && ($devBranch =~ m~/$opt_branch$~) )
            {
                my @msgText;
                push ( @msgText,
                        "The package Tag was not taken from the development branch",
                        "Development Branch: $devBranch\@$tagPeg",
                        "Tag traced back to: $tagLabelBranch\@$tagLabelBranchPeg" );
                if ( $traceBack == 1) {
                    push @messageText, @msgText;
                } else {
                    Error ( @msgText );
                }
            }
        }
        $devBranchPeg = $tagLabelBranchPeg unless ( $devBranchPeg );

        #   Ensure that the TAG has not been modified since it was taken
        #   The extraction algorithm assumes that the tag directory is
        #   immutable.
        #
        #   The build daemon will actually modify the build file during
        #   a ripple - this is catered for.
        #
        #   If other files have been modifed then it should be an error
        #
        if ( $btData->{changeSets} > 1 )
        {
            Error ("Tag has been modified since created") if ( $GBE_ABT );
            Warning ("Tag has been modified since created");
            $noReleaseWs = 1;
        }
    }
}
#debugDumpRefInfo('BackTrack Label');

#
#   Examine the HEAD of the development branch and determine if there
#   have been any changes since the tag was taken
#
determineChangedFiles();

################################################################################
#   Create a workspace based on the tag
#   It will be back tracked to the branch that was tagged:
#       - Ripple build tags look better in version tree
#       - User can develop in the workspace as its not linked to an immutable 'tags'
#
#   So far we have:
#       $initialUrl         - Url to the version that the user specified
#       $initialUrlBranch   - Url to the branch from which the initialUrl was taken
#                             Iff based on a Tag
#       $urlDevBranchHead   - Head of the Development Branch
#

$initialUrl = substr( $initialUrl, 1 + length($srcPathPkg));

my $initialUrlBranch;
if ( $tagLabelBranch )
{
    $initialUrlBranch  = $tagLabelBranch;
    $initialUrlBranch .= '@' . $tagLabelBranchPeg;
}

my $urlDevBranchHead;
if ( $devBranch )
{
    $urlDevBranchHead  = $devBranch;
}
else
{
    $urlDevBranchHead  = $tagLabelBranch;
}

#
#   Debug information
#
if ( IsVerbose(1) ) {
    debugDumpRefInfo('Creating workspaces');
    Verbose ('------------');
    Verbose ("initialUrl       :", $initialUrl);
    Verbose ("initialUrlBranch :", $initialUrlBranch );
    Verbose ("urlDevBranchHead :", $urlDevBranchHead );
    Verbose ("opt_viewname     :", $opt_viewname );
#    DebugDumpData("svn_label", $svnSession );
}

#
#   If we are only extracting files then ...
#
if ( $opt_extract_files )
{
    Warning(@messageText );
    extract_files_from_view();
    exit (0);
}

#
#   Create a new workspace
#       This is not done if the user is reusing an existing workspace
#       AND the existing workspace exists.
#
if (! -d $VIEWDIR || ! $opt_reuse )
{
    Message( "Create the workspace" . ($GBE_SANDBOX ? " in a SANDBOX" : ''));

    my $branch;
    my $view_tag;
    my $update_tagsChanges;
    if ( $opt_devMode eq 'tip' ) {
        $view_tag =  $urlDevBranchHead;
    } elsif ( $opt_devMode eq 'exact' ) {
        $view_tag =  $initialUrl;
    } else {
        $view_tag = $initialUrlBranch || $initialUrl;
        $update_tagsChanges = 1;
    }
    Message ("Creating Workspace based on: $view_tag");
    $view_tag = $svnSession->FullPath() . '/' .$view_tag;
    Verbose("Creating Workspace:", $view_tag);
    
    #
    #   If a branch is required ...
    #   Two modes:
    #       mkbranch    - Ensure that the branch does not exist
    #                     Make a new one
    #       branch      - Ensure that the branch does exist
    #                     Use existing branch
    #   Ensure that the branch is NOT in the Repository
    #
    if ( $opt_branch )
    {
        $branch = $svnSession->BranchName($opt_branch, 'branches' );
        $svnSession->SvnValidateTarget (
                        'cmd'    => 'SvnRelease: Validate Branch',
                        'target' => $branch,
                        'require' =>   (! $opt_mkbranch),
                        'available' => (  $opt_mkbranch),
                        );

        #
        #   If using an existing branch, then:
        #       Set up the name of the source
        #       Do NOT import tag changes - we will be extracting the HEAD of the branch
        #
        if ( ! $opt_mkbranch )
        {
            $view_tag = $branch;
            $update_tagsChanges = 0;
        }
    }

    #
    #   Perform delayed delete of any existign view
    #   The process has been delayed as much as possible - in case other tests fail
    #
    delete_view();

    #
    #   Create the workspace
    #
    $svnSession->SvnCo ( $view_tag, $workSpace , 'escrow' => $opt_escrow );
    Error ("Cannot locate the created Workspace")
        unless ( -d $workSpace);
    importTagChanges()
        if ($update_tagsChanges);

    #
    #   If we need to create a branch then
    #       Copy the WS to URL
    #       Switch to new URL
    #   The bulk of the copy will be done on the server-side
    #   and not over the network. This is  good.
    #
    if ( $opt_mkbranch )
    {
        #
        #   Branch does not exist
        #   Create it be copying the base view
        #
        Message ("Creating branch: $opt_branch");
        my $branch_tag = $svnSession->SvnCopy (
                        'old' => $workSpace,
                        'new' => $branch,
                        'comment' => 'Created by Jats SvnRelease branch request',
                        'replace' => 0 );

        Verbose ("Switching to new branch: $opt_branch");
        $branch_tag = SvnPath2Url($branch_tag);
        $svnSession->SvnSwitch ($branch_tag,
                               $workSpace,
                               '--NoPrint' );
    }

    #
    #   Create a local package archive
    #   May be needed for multipackage builds and it will prevent JATS from
    #   finding any outside the view
    #
    mkdir ( $VIEWDIR . '/local_dpkg_archive')
        unless ($GBE_SANDBOX);

    #
    #   Display messages AFTER the extraction text
    #   Will ensure that the user has a chance to see them
    #
    Warning(@messageText );
    
}

#   Place a tag-file in the user-specified source path
#   This will be used by the build-tool to locate the 'source-path' of the
#   view, primarily for determining metrics.
#
#   Calculate where the dynamic view will be
#   This differ between UNIX/WINDOWS
#
if ( $GBE_ABT)
{
    Message("Create Build tagfile");
    TouchFile ( "$workSpace/.jats.packageroot" )
        if ( -d $workSpace )
}

#
#   Locate the JATS build files within the populated view
#
chdir ($VIEWDIR) or Error("Cannot chdir to $VIEWDIR");
Message( "Locating build files");

my $bscanner = BuildFileScanner( $VIEWDIR, 'build.pl', '--LocateAll' );
$bscanner->scan();
my @build_list = $bscanner->getInfo();
foreach my $be ( @build_list )
{
    Message(DisplayPath ("Build file: $be->{dir} Name: $be->{file}"));
}

#
#   If we are extracting the view then we are done
#   Display useful information for the user
#
if ( $opt_extract )
{
    Message  DisplayPath "View in: $VIEWDIR";
    Warning ("No build files found" )   if ( $#build_list < 0 );
    Warning( "Multiple build files found" )if ( $#build_list > 0 );
    Message ("Not all labels are pegged") if ( @label_not_pegged  );
    Message ("All labels are pegged") unless ( @label_not_pegged  );
    Message ("Badly formed label name" ) if ( $bad_label_name );
    Message ("Development Mode: $opt_devModeStr") if ( $opt_devModeStr );
    Message ("Development Sandbox") if ( $GBE_SANDBOX );
    Message ("Cannot release from this workspace") if ($noReleaseWs);

    exit 0;
}

Error ("No build files found")  if ( $#build_list < 0 );

#
#   Determine the list of builds to perform
#   Ensure that the user-requested build files are present
#
#   The user specifies the build file, via the mangled package name
#   This is package_name . project extension (daf_utils.cr)
#
if ( $#opt_build  >= 0)
{
    Verbose( "Check and locate the build files");
    @build_list = ();
    foreach my $bentry ( @opt_build )
    {
        if ($bscanner->match( $bentry) )
        {
            UniquePush (\@build_list, $bscanner->getMatchList() );
            Verbose ("Found: $bentry");
        }
        else
        {
            Error ("Cannot locate requested build files for: $bentry")
        }
    }
}

#
#   Sanity test if we will transfer the generated package to dpkg_archive
#   There are some limits
#       1) Must have built from one label
#       2) That label must be locked
#       3) Only one build file
#       4) The view must not have been reused
#       5) The view has a branch rule
#       6) Cannot release from a sandbox
#
my @elist;
push @elist, "Package built from multiple labels" unless ( $label_count == 1 );
push @elist, "Package built from an unpegged label" if ( @label_not_pegged  );
push @elist, "Package built with multiple build files" if ( scalar @build_list > 1 );
push @elist, "Package from a reused view" if ( $opt_reuse && ! $opt_beta );
push @elist, "Package from a development sandbox" if ( $GBE_SANDBOX );
push @elist, "Package from a development workspace" if ($noReleaseWs);
push @elist, "View contains a branch" if ( $opt_branch );
push @elist, "User has specified build files" if ( $#opt_build > 0 );
push @elist, "Badly formed label name" if ( $bad_label_name );

if ( @elist )
{
    Warning ("Cannot officially release the package.", @elist);
    Error ("Build terminated as it cannot be released") if ($opt_dpkg && ! $opt_beta);
}
Warning ("Beta Release") if $opt_beta;

#
#   Process each of the build files in the specified order
#
foreach my $be (@build_list)
{

    #
    #   We need to change to the build directory
    #   Moreover we need the local name of the build directory.
    #   Windows does not handle a UNC pathname to well (at all)
    #
    my $build_dir = $be->{dir};
    chdir ("$build_dir") or Error( "Cannot chdir to build directory: $build_dir");

    if ( $be->{file} =~ m/^build.pl$/ )
    {
        Message ("Using JATS: $build_dir");
        #
        #   Invoke JATS to build the package and make the package
        #
        my @build_args = qw(--expert --cache);
        push @build_args, '--cache' if $opt_cache;

        my $make_type = 'all';
        $make_type = 'all_prod'  if ( $opt_prod_build );
        $make_type = 'all_debug' if ( $opt_debug_build );


        JatsCmd('build', @build_args)               and Error("Package did not build");
        JatsCmd('make', $make_type, 'NODEPEND=1')   and Error("Package did not make");
        JatsCmd('install');

        if ( $opt_runtests )
        {
            JatsCmd('make', 'run_unit_tests')      and Error("Tests did not run correctly");
        }
    }
    else
    {
        #
        #   Ant build files
        #
        my $pname =  $be->{file};
        Message ("Using ANT: $build_dir, $pname");
        $pname =~ s~depends.xml$~.xml~;
        copy($be->{file}, "auto.xml");
        JatsCmd('-buildfile', $pname, 'ant', 'build')        and Error("Package did not build");
        JatsCmd('-buildfile', $pname, 'ant', 'make_package') and Error("Package did not make_package");
    }
}

#
#   Copy the generated packages
#       1) dpkg_archive
#       2) Users local directory
#
foreach my $be (@build_list)
{
    my $build_dir = $be->{dir};
    chdir ("$build_dir") or Error( "Cannot chdir to build directory: $build_dir");
    if ( $opt_dpkg )
    {
        Message ("Using: $build_dir");
        my @create_opts = "-o";
        push @create_opts ,"-m" if ( $opt_merge );
        JatsCmd('-here', 'create_dpkg', @create_opts, '-pname', $be->{name}, '-pversion', $be->{version}) and $error++;
    }

    if ( $opt_copy )
    {
        Message ("Copy package to $user_cwd");
        copy_directory( 'pkg', $user_cwd, '' );
    }

    #
    #   Test structure of the package
    #   Ensure that it has a descpkg file
    #   Validate the package name and version
    #   More important for ANT projects than JATS as JATS has a sanity test
    #
    if ( $opt_test )
    {
        JatsCmd('-here', 'create_dpkg', '-test', '-pname', $be->{name}, '-pversion', $be->{version}) and $error++;
    }

}
Error ("Package not transferred")
    if ( $error );

chdir ($user_cwd) or Error( "Cannot chdir to $user_cwd");

#
#   Delete the view
#
if ( ! $opt_reuse && ! $error && ! $opt_keep )
{
    delete_view();
}
else
{
    Message( "View left in: $VIEWDIR" );
}

Message ("End program");
exit 0;

#-------------------------------------------------------------------------------
# Function        : delete_view
#
# Description     : Delete a view
#
# Inputs          : None
#                   $VIEWDIR - path of the view
#
# Returns         :
#
sub delete_view
{
    my $cofound = 0;
    my $uuid;
    #
    #   Simple delete
    #
    if ( $opt_extract_files )
    {
        if ( -d $VIEWDIR )
        {
            Message("Remove extracted files: $VIEWDIR");
            RmDirTree( $VIEWDIR );
        }
    }
    else
    {
        #
        #   If the view physically exists then attempt to physically remove it
        #
        if ( -d $VIEWDIR )
        {
            #
            #   Determine if there are any checked out files in the view
            #
            Message("Remove the view: $VIEWDIR");
            Verbose("Look for checked out files");


            SvnRmView ('path'     => $workSpace,
                       'force'    => ($opt_delete > 1) || ($opt_extract > 1),
                       'modified' => [ 'local_dpkg_archive' ] );
        }
        Warning ("View was not deleted. Will Delete view directory")
            if ( -d $workSpace );
        RmDirTree( $VIEWDIR ) if $opt_path;
    }

    Error ("View was not deleted")
        if ( -d $VIEWDIR );
}

#-------------------------------------------------------------------------------
# Function        : copy_directory
#
# Description     : Copy a directory tree
#
# Inputs          : Source directory
#                   Target directory
#                   Strip
#
#                   Should be full pathnames
#
# Returns         :
#
my $copy_error;
my $copy_count;
sub copy_directory
{
    our ($src_dir, $dest_dir, $strip) = @_;
    our $slength = length ($strip);

    #
    #   Prevent File::Find from generating warnings
    #
    no warnings 'File::Find';


    #
    #   Helper routine to copy files
    #
    sub copy_file_wanted
    {
        #
        #   Do not copy directories
        #   Just make the directory entry. May result in empty directories
        #
        if ( -d $_ )
        {
            my $tdir = "$dest_dir/" . substr( $File::Find::dir, $slength);
            $tdir .= "/$_";
            File::Path::mkpath( $tdir )
                unless ( -d $tdir);
            return;
        }

        #
        #   When used to copy file from within a clearcase dynamic view the
        #   files may not actually exist. This will generate an error later
        #   so check for existence of file file now.
        #
        return unless ( -e $_ );

        #
        #   Have been chdir'ed to the source directory
        #   when invoked
        #
        my $tdir = "$dest_dir/" . substr( $File::Find::dir, $slength);
        my $tfile = "$tdir/$_";
        my $sfile = "$File::Find::dir/$_";
        Verbose ("Copy: $sfile -> $tfile");

        File::Path::mkpath( $tdir )
            unless ( -d $tdir);

        unlink ( $tfile )
            if ( -f $tfile );

        if( ! File::Copy::copy ( $_ , $tfile ) )
        {
            $copy_error++;
            Message "Error copying $sfile";
        }
        else
        {
            my $perm = (stat $_)[2] & 07777;
            chmod($perm, $tfile);

            $copy_count++;
        }
    }

    #
    #   Locate all files to copy
    #
    $copy_error = 0;
    $copy_count = 0;
    File::Find::find ( \&copy_file_wanted, $src_dir );
    return $copy_error;
}

#-------------------------------------------------------------------------------
# Function        : count_files
#
# Description     : Count files in a workspace
#                   Ignore .svn stuff
#
# Inputs          : Source directory
#
# Returns         :
#
sub count_files
{
    my ($src_dir) = @_;

    #
    #   Prevent File::Find from generating warnings
    #
    no warnings 'File::Find';


    #
    #   Helper routine to copy files
    #
    sub count_file_wanted
    {
        #
        #   Do not count dirs, only files
        #
        return if ( -d $_ );
        $copy_count++;
    }

    #
    #   Locate all files
    #
    $copy_count = 0;
    File::Find::find ( \&count_file_wanted, $src_dir );
}


#-------------------------------------------------------------------------------
# Function        : extract_files_from_view
#
# Description     : This function will
#                       Extract the files from the required source
#                       This is a simple operation under subversion
#
#                   Its used in the creation of escrow directories
#
# Inputs          : None
#                   All done via globals
#
# Returns         : 
#
sub extract_files_from_view
{
    #
    #   Determine the target directory for the extracted files
    #       Delete the output subdir
    #       Create the config spec in that directory
    #
    Verbose("Extracting files into $VIEWDIR");
    if ( -d $VIEWDIR )
    {
        Verbose "Delete Directory: $VIEWDIR\n";
        RmDirTree( $VIEWDIR );
    }

    #
    #   Determine URL to extract
    #       work : Same as exact
    #       exact: Use user provided tag
    #              No need to backtrack to the branch and then
    #              Update files
    #
    #       tag:   Don't update build files
    #              This is different normal mode
    #              Perhaps should change to be the same as exact - just extract
    #              the user provided tag
    #
    #       tip:   Don't update build files
    #
    my $view_tag;
    if ( $opt_devMode eq 'tip' ) {
        $view_tag =  $urlDevBranchHead;
    } elsif ( $opt_devMode eq 'tag' ) {
        $view_tag = $initialUrlBranch;
    } else {
        $view_tag = $initialUrl;
    }

    $svnSession->SvnCo ( $svnSession->FullPath() . '/' . $view_tag,
                        $VIEWDIR,
                        'export' => 1,
                        'escrow' => $opt_escrow,
                        'print' => 0 );

    #
    #   Count this files in the view
    #   Done so that its clear when we have a empty workspace in escrow extractions
    #
    Verbose ("Examine View contents");
    count_files ( $VIEWDIR );
    Error ('ExitCode=10', DisplayPath("View files in: $VIEWDIR, but no files were extracted"))
        unless ($copy_count);
    Message ("View files in: $VIEWDIR, Files: $copy_count" );
}

#-------------------------------------------------------------------------------
# Function        : importTagChanges
#
# Description     : import changes from a 'tag' into the target workspace
#                   Use with a workspace as well as an exported target
#
# Background      :
#   The workspace has been created on the branch from which the tag was taken
#   BUT this may not be the same as the tag because:
#       1) Developer is not respecting the use of tags
#       2) The automated build system will place the rippled build files
#          within the tag.
#   The most effective way that I have found of getting the modified build
#   files into the workspace is to:
#       Parse the log of the tag
#       Determine files that have been modified as a part of the tag
#       export them into the workspace
#
#   If we are creating a workspace that we are about to branch, then
#   we use 'switch' to copy in the new file
#   Otherwise, use a 'co -export'. If we use a switch, then the files
#   that have been switched in cannot be commited if changed as they will
#   be within the 'tags' area.
#
# Inputs          : None
#                   Globals
#
# Returns         : Error code
#
sub importTagChanges
{
    return unless ( $tagLabel );
    my $data = $svnSession->{SavedBackTrack};
    Error ("Internal: importTagChanges expects backtracking to have been performed")
        unless (defined $data);

#    DebugDumpData("importTagChanges", $svnSession );
#    DebugDumpData("Data", $data );

    #
    #   Process the data from the backtrack log and determine the files
    #   that we need to transfer.
    #       Should only be one - but if the users have been bad
    #       then there may be more.
    #
    if ( $data->{files} )
    {
        foreach my $srcFile ( reverse @{$data->{files}} )
        {
            Verbose("importTagChanges: $srcFile");
            my $sfile = $svnSession->FullPath() . '/' . $srcFile;

            #
            #   Calculate path within the repo of the target file
            #
            unless($srcFile =~ m~tags/.*?(/.*)@\d+~)
            {
                #
                #   Only seen this error under a condition where the user
                #   tagged a parent directory. ie:
                #       aaa/bbbb/tags/badTag was a copy of aaa
                #
                Error ("importTagChanges. Unexpected format of filename: $srcFile",
                       "Possible cause: Incorrect tag placement");
            }
            my $tfile = $workSpace . $1;

            if ( $opt_mkbranch )
            {
                $svnSession->SvnSwitch ($sfile, $tfile);
            }
            else
            {
                $svnSession->SvnCo ($sfile, $tfile,
                                        'export' => 1,
                                        'force' => 1,
                                        'escrow' => $opt_escrow,
                                        'pretext' => 'Replacing ' );
            }
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : determineChangedFiles
#
# Description     : Display a list of files that have been changed between
#                   the tagPoint and the head of the branch
#
# Inputs          : Only Globals
#
# Returns         : Will not return if changes are not allowed
#
sub determineChangedFiles
{
    my @msgText;
    my $onlyWarn = ($checkDelta == 1);

    #
    #   No checking required
    #   Skip the hard bit if running on a build machine
    #
    return unless ( $checkDelta );
    return if ( $onlyWarn && ! $devBranch && ! $tagLabelBranch );

    Debug ('determineChangedFiles');
#debugDumpRefInfo('determineChangedFiles');

    #
    #   Examine the HEAD of the development branch and determine if there
    #   have been any changes since the tag was taken
    #
    #   Determine the Repo Revision for the HEAD of the devBranch
    #
    Error ("Internal: No devBranch calculated") unless ( $devBranch || $tagLabelBranch );

    my $basePeg = $tagLabelBranchPeg || $devBranchPeg;
    my $baseBranch = $tagLabelBranch || $devBranch;
    Error ("Internal logic. Expecting tagLabelBranchPeg or devBranchPeg to be defined") unless ( $basePeg );
    Error ("Internal logic. Expecting tagLabelBranch or devBranch to be defined") unless ( $baseBranch );

    my $svn_check = NewSessionByUrl ( join( '/', $srcPathPkg, $baseBranch), 1 );
    my $rv = $svn_check->SvnInfo( $svn_check->Full, 'InfoRepo' );
    if ( $rv )
    {
        push (@msgText, "Cannot read information for the head of the development branch",
                        "Branch may not exist: $baseBranch");
        $onlyWarn = 1;
    }
    else
    {
        $devBranchHead = $svn_check->{'InfoRepo'}{'Last Changed Rev'};
        Verbose2("devBranchHead: $devBranchHead");
    #debugDumpRefInfo('Dev Branch Head');


        #
        #   If the Rev of the HEAD is greater than the point at which we
        #   are interested then changes may have occured. Otherwise we know
        #   that changes cannot have occured
        #
        if ( $devBranchHead <= $basePeg )
        {
            return;
        }

        if ( $tagLabelBranchPeg )
        {
            push @msgText,  "Development Branch has changed since Tag was taken",
                            "Head last changed in Rev: $devBranchHead",
                            "Tag traced back to Rev  : $basePeg";
        } else
        {
            push @msgText,  "Development Branch has changed since specified version",
                            "Head last changed in Rev: $devBranchHead",
                            "Specified branch Rev    : $basePeg";
        }


        my $diffBase = $svn_check->FullPath() . '/' . $baseBranch;
        $svn_check->{tmp}{path_length} = length($diffBase);
        $svn_check->{tmp}{count}  = 0;
        @{$svn_check->{tmp}{files}}  = ();

        $rv = $svn_check->SvnCmd ( 'diff', '--summarize',
                                   $diffBase,
                                   '--revision', $basePeg . ':HEAD',
                                   {
                                        'process' => \&ProcessDiff,
                                        'credentials' => 1,
                                        'nosavedata' => 1,
                                   }
                                );
        #
        #   Prepare message to be displayed
        #   Prepend text to the list of files
        #

        $rv = $svn_check->{tmp}{count};
        return unless ( $rv );
        push (@msgText, "No files changed") unless ( $rv );
        push (@msgText, "Changed file count: $rv") if ( $rv );
        push (@msgText, "More than 10 files have changed. First 10 are:") if ( $rv > 10);
        push (@msgText, @{$svn_check->{tmp}{files}} );
    }

    if ($onlyWarn) {
        push @messageText, @msgText;
    } else {
        Error ( @msgText );
    }
}

sub ProcessDiff
{
    my $self = shift;
    my $data = shift;

    #
    #   Extract filename from line
    #       First 8 chars are status
    #       Remove WS path too
    #
    my $path_length = $self->{tmp}{path_length} + 1 + 8;
    if ( length $data >= $path_length )
    {
        my $file = substr ( $data, $path_length );
        push @{$self->{tmp}{files}}, '  Changed: ' .  $file
            if ( $self->{tmp}{count}++ < 10 );
    }

    return 0;
}

#-------------------------------------------------------------------------------
# Function        : parseSubversionRef
#
# Description     : Parse the user-provided Subversion Ref
#
#                   Convert label with embedded VCS information into a 'normal' form.
#                   Form:
#                       SVN::<SourcePath>::<Label>
#                       SVN::<SourcePath>::<Peg>
#                   
#                   Allow optional 'SVN::' prefix
#                   Allow Full or Symbolic URL
#                       [SVN::]<SourcePath>::<Label>
#                       [SVN::]<SourcePath>::<Peg>
#                       [SVN::]<URL>
#
# Inputs          : $opt_spec               - User Provided Ref
#
# Returns         : Will not retirn on gross error
#                   Values return in global variables
#
sub parseSubversionRef
{
    my ($opt_spec) = @_;

    $opt_spec =~ s~^SVN::~~;
    if ( $opt_spec =~ m~(.+)::(.+)~ )
    {
        my $sourcePath = $1;
        my $label = $2;
        $urlType = 'jats';

        #
        #   Sanity test of sourcePath
        #
        Error ("Invalid use of a peg: $opt_spec[0]")
            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 '');

            $srcPathPkg = $1;
            $ttbType = $3;
            $devBranch = $3;
            $devBranch .= '/' . $5 if ( $5 ne '' );
        }
        else
        {
            Error ("Source Path does not contain tags or trunk or branches component");
        }

        #
        #   Pull apart the 2nd argument
        #   May be a raw peg - on the development branch
        #   May be a tag and a peg
        #
        $initialUrl = $srcPathPkg;
        if ( $label =~ m~^@*(\d+)$~ )
        {
            # Full numeric label - is a peg on the development branch
            $devBranchPeg = $1;
            $initialUrl .= '/' . $devBranch . '@' . $devBranchPeg;
        }
        elsif ( $label =~ m~^([^@]+)@(\d+)$~ )
        {
            $tagLabel = 'tags/' . $1;
            $tagPeg = $2;
            $initialUrl .= '/tags/' . $label;
        
        }
        elsif ( $label !~ m~@~ )
        {
            $tagLabel = 'tags/' . $label;
            $initialUrl .= '/tags/' . $label;
        }
        else
        {
            Error ("Subversion Tag badly formed: $label");
        }
    } elsif ($opt_spec =~ m~::~) {
        Error ("Badly formed Subversion Reference: $opt_spec[0]");

    }
    else
    {
        # Have a full URL and not a JATS enhanced spec
        # Cannot determine the development branch and the tag
        #
        $urlType = 'url';
        $initialUrl = $opt_spec;

        # Extact any peg
        my $peg;
        if ( $opt_spec =~ m~(.*)@(\d+)$~ )
        {
            $opt_spec = $1;
            $peg = $2;
        }

        if (  $opt_spec =~ m~(.*)/((tags|branches|trunk)(/|$)(.*))~ )
        {
            Error ("Subversion URL has insufficient items")
                if ( $1 eq '' );
            $srcPathPkg = $1;
            $ttbType = $3;

            if ( $ttbType eq 'trunk' ) {
                Error ("Subversion URL must NOT contain items after '$ttbType'")
                    if ( $5 ne '' );
                $devBranch = $2;
                $devBranchPeg = $peg;

            } elsif ( $ttbType eq 'tags' ) {
                Error ("Subversion URL must contain items after '$ttbType'")
                    unless ( $5 ne '' );
                $tagLabel = $2;
                $tagPeg = $peg;

            } else {
                Error ("Subversion URL must contain items after '$ttbType'")
                    unless ( $5 ne '' );
                $devBranch = $2;
                $devBranchPeg = $peg;
            }
        }
        else
        {
            Error ("Subversion URL does not contain tags or trunk or branches component");
        }
    }
    #debugDumpRefInfo('First Parse');
}

#-------------------------------------------------------------------------------
# Function        : calcViewName
#
# Description     : Calculate a nice name for the view
#                   Try to keep short and informative
#                       Some legacy tools hate long paths.
#                       See Jira issue: JATS-274
#                   Try to base the name on the tag
#
#                   If the URL looks like a TTB then we can make some guesses
#                   as to the package name and version.
#
#                   Add indication for the Dev Mode
#                   Add indication for a branch

#
# Inputs          : Nothing
#
# Returns         : A 'nice' ViewName
#                   Will not return on error
#
sub calcViewName
{
    #
    #   Use the user provided view name if its valid
    #
    if ( $opt_viewname )
    {
        Error ("View Name contains invalid characters" )
            unless ( $opt_viewname =~ m~^[0-9a-z]([-.:0-9a-z_]*[0-9a-z])?$~i );
        return $opt_viewname ;
    }

    #
    #   Create a view name based on the provide URL or SVN Reference
    #
    my $version;
    my $name = $srcPathPkg;
    my $isaWIP;

    $name =~ s~.*/~~;

    if ( $tagLabel )
    {
        $version = $tagLabel;
        $version =~ s~.*/~~;
        $isaWIP = $version =~ m~\.WIP$~;

        # Remove package name from the tag
        # Allow for WIPs too
        #       XXXX_nnnn.ppp.WIP   WIP: Name is upper case. Join is.
        #       xxxx_nn.nn.nn.ppp   TAG: Name is same case. Join is _
        $version = $1 if ( $version =~ m~^${name}[_.](.*)~i );
    }
    elsif ( $devBranch )
    {
        $version = $devBranch;
        $version =~ s~.*/~~;
    }

    if ( $version && $name )
    {
        $opt_viewname = join( '_', $name, $version);
    }
    elsif ( $svnSession->Type )
    {
        $opt_viewname = $svnSession->Path;
        $opt_viewname .= '_' . ($svnSession->Version || 'trunk') unless $opt_branch;

        #
        #   Tags and Branches 'should' include the package name
        #   This will lead to a duplication of the package name
        #   ie: aaaaa/package/tags/package_version
        #   Attempt to remove these
        #
        if ( $opt_viewname =~ s~[_/]([\-.:0-9a-zA-Z]+)_\1_~_$1_~ )
        {
            Verbose ("Removed duplicate package name: $1 from $opt_viewname");
        }
    }
    else
    {
        $opt_viewname = $svnSession->Path;
        $bad_label_name = 1;
    }

    #
    #   Append the peg if provided
    #       Not if creating a 'tip' as its a bit meaningless
    #       Not if a WIP as it should have been provided and is not noise
    #
    if ( my $peg = $tagPeg || $devBranchPeg )
    {
        unless( $opt_devMode eq 'tip' || $isaWIP)
        {
            $opt_viewname .= '_' . $peg;
        }
    }

    #
    #   Append information to indicate the exact type of the WorkSpace
    #   Normally mutually exclusive
    #
    $opt_viewname .= '_Tip' if ( $opt_devMode eq 'tip' );
    $opt_viewname .= '_Tag' if ( $opt_devMode eq 'tag' );
    $opt_viewname .= '_Exact' if ( $opt_devMode eq 'exact' );
    $opt_viewname .= '_' . $opt_branch if ( $opt_branch );

    #
    #   Create a simple dir name
    #       Remove path sep characters and replace with _
    #       Remove Peg marker (@) as this breaks svn
    #       Replace multiple _ with a single _
    #       Remove trailing _ - caused by URL with a trailing /
    #
    $opt_viewname =~ s~[^\-.:0-9a-zA-Z_]~_~g;
    $opt_viewname =~ tr~_~_~s;
    $opt_viewname =~ s~_+$~~;
    return $opt_viewname;
}

#-------------------------------------------------------------------------------
# Function        : debugDumpRefInfo
#
# Description     : Dump the current Ref Information
#
# Inputs          : $text
#
# Returns         : 
#
sub debugDumpRefInfo
{
    Verbose0 ('-' x 40);
    Verbose0 ('debugDumpRefInfo:' , @_ );
    Verbose0 ('ttbType           :', $ttbType);
    Verbose0 ('urlType           :', $urlType);
    Verbose0 ('Base              :', $svnSession->FullPath() ) if $svnSession;
    Verbose0 ('initialUrl        :', $initialUrl);
    Verbose0 ('srcPathPkg        :', $srcPathPkg);
    Verbose0 ('devBranch         :', $devBranch);
    Verbose0 ('devBranchPeg      :', $devBranchPeg);
    Verbose0 ('devBranchHead     :', $devBranchHead);
    Verbose0 ('tagLabel          :', $tagLabel);
    Verbose0 ('tagPeg            :', $tagPeg);
    Verbose0 ('tagLabelBranch    :', $tagLabelBranch);
    Verbose0 ('tagLabelBranchPeg :', $tagLabelBranchPeg);
}

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


#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    GENERAL::Subversion::

=head1 NAME

jats_svnrelease - Build a package given a SubVersion label

=head1 SYNOPSIS

  jats svnrelease [options] [-label=]label

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -label=xxx         - Subversion label
    -spec=xxx          - Same as -label=xxx
    -path=xxx          - Source Path
    -view=xxx          - Modify the name of the created view
    -build=xxx         - Package Name to build
    -root=xxx          - Root directory for generated view
    -[mk]branch=xxx    - Will create/use a branch
    -tag=xxx           - Compatibility. Not used
    -extract           - Extract the view and exit
    -extractfiles      - Extract files, without a view
    -devMode=xxx       - Create Workspace suitable for development.(Tip,Tag,...)
    -cache             - Refresh local dpkg_archive cache
    -delete[=n]        - Remove any existing view and exit
    -debugOnly         - Make only the debug version
    -prodOnly          - Make only the production version
    -[no]dpkg          - Transfer package into dpkg_archive
    -[no]copy          - Transfer pkg directory to the current user directory
    -[no]reuse         - Reuse the view
    -[no]test          - Test package build. Implies nocopy and nodpkg
    -[no]keep          - Keep the view after the build
    -[no]beta          - Release a beta package
    -[no]merge         - Merge packages into dpkg_archive
    -[no]runtests      - Run units tests. Default is runtests
    -[no]prefix        - Suppress user prefix in view name. Default prefix is USER

=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<-label> or B<-spec>

The Subversion label to use as the base for the workspace. The utility will
accept the following forms of label identifier, each with an optional 'SVN::' prefix.

=over 4

=item Full URL

This form is identified by the complete lack of the '::' subfield delimiter. The
URL is used as provided. It is not modified.

 Eg: AUPERASVN01/DPG_SWBASE/daf_utils_math/tags/daf_utils_math_3.2.1@12345
 Eg: https://auperasvn01.aupera.erggroup.com/svn/DPG_SWBASE/daf_utils_math/tags/daf_utils_math_3.2.1@12345


=item SourcePath::Tag

The SourcePath component is used to calculate the root of the package directory.
The source path is then caclulated assuming that the 'Tag' exists within a
'/tags' subdirectory of the root of the package.

This is the form preferred by Release Manager and the VIX build system.

 Eg: AUPERASVN01/DPG_SWBASE/daf_utils_math/trunk::daf_utils_math_3.2.1@12345

=item SourcePath::Peg

A special case of of the 'SourcePath::Tag' form is invoked if the 'Tag' component
is numeric. It will be treated as a peg of the Base Path.

 Eg: AUPERASVN01/DPG_SWBASE/daf_utils_math/trunk::12345

=back

=item B<-view name>

Specified an alternate view name and tag to be used. This option does not provide the
full name of the view.

The view path will be: "${USER}_${NAME}"

The default "NAME" is the first label specified with the repository and tag removed.

If the user provides a view "name" that is prefixed with their user name
('${USER}_'), then the username will be stripped of for internal processing.
This allows a user to provide a view path when deleting a view.

=item B<-path=xxx>

Specifies the source path to the root of the extracted file tree. This option is
not mandatory and is only used to maintain toolset compatibility with other
,similar, tools.

If provided, then the Workspace will be created within the named subdirectory
tree within the base of the view.

=item B<-build=xxx>

This option allows the user to specify the packages to be built and the
order in which the packages are to be built.
This is useful if the extracted view contains multiple build files

This option may be used multiple times.

There are two forms in which the build target can be specified. It can be
specified as a full package name and version, or as a package name and the
project suffix.

By default the program will assume that there is only one build file in the
view and will not build if multiple files are present, unless the package to be
built can be resolved.

The location mechanism operates for both JATS and ANT build files.

Example: -build=jats-api.1.0.0000.cr

This will locate the build file that builds version 1.0.0000.cr of the jats-api
package. The version numbers must match exactly.

Example: -build=jats-api.cr -build=jats-lib.cr

This will located the build files that build the jats_api (cr) package and the
jats-lib (cr) package. The version of the packages will not be considered.

=item B<-root=xxx>

This option allows the location of the generated view to be specified on the
command line. It overrides the value of GBE_VIEWBASE.

If the command is invoked within a development sandbox, then the default
location will be the root directory of the development sandbox.

=item B<-mkbranch=xxx>

This option will create a workspace associated with a branch within the
repository. This is intended to facilitate the maintenance of existing packages
and the creation of project or development branches.

The named branch must not exist. It is an error for the branch to exist.

This tool will copy the specified source version to the branch, create a
workspace based on the branch and then switch to the branch.

This option is intended to create a development thread, for project or private
use.

A branch name 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 B<-branch=xxx>

This option will create a workspace associated with a branch within the
repository. This is intended to facilitate the maintenance of existing packages
and the creation of project or development branches in a manner similar to
ClearCase.

The named branch must exist. It is an error for the branch to not exist.

If the named branch does exist, then this tool will create a workspace based
on the head of the branch.

This option is intended to extract the tip of a development thread.

=item B<-tag=text>

This option is not used.
It is present to maintain compatibility with the buildtool interface.

=item B<-extract>

With this option the view is created and the left in place. The user may then
access the files within the view. The view should not be used for a
production release.

=item B<-extractfiles>

With this option the utility will create a dynamic view and transfer files from
the view to the user's target. The dynamic view is then removed.

This command is intended to simplify the process of creating an escrow.

=item B<-devMode=mode>

This option controls the exact form of the Workspace create. The svnRelease
command supports the following modes (default is working):

=over 4

=item   Tag or TagPoint

The workspace will contain the point on the packages development branch from
which the specified tag was copied.

The extraction process will highlight file differences between the specified tag
and the tip. If any differences are found then these will be treated as an error.

The user B<should> resolve this error by selecting, in Release Manager, a
version of the package based on the tip of the Development Branch.

This is the preferred Development Mode for working on a package as it provides
checks to ensure that the Meta Data held in Release Manager is consistient.

=item   Work or Working

The workspace will contain the point on the packages development branch from
which the specified tag was copied.

The extraction process will highlight file differences between the specified tag
and the tip of the Development Branch. Unlike the 'Tag' Mode, such differences
are not treated as an error.

This mode of WorkSpace has several features and constraints:

=over 4

=item *

The build files from the 'tagged' version will be transferred into the
WorkSpace. These will be seen as modified files.

=item *

This style of workspace can be converted into a 'Tip' style through the use of the
Subversion 'update' command.

=item *

If there have been changes to the Development Branch, then it not be possible to
'commit' the workspace. It may need to be branched first.

=back

=item Tip or BranchTip

The workspace will contain the 'tip' of the Packages Development Branch.

The extraction process will highlight file differences between the specified tag
and the tip.

=item Exact

The workspace will be directly based on the Tag or URL provided by the user.

The resultant workspace may not be suitable for development.

The extraction process will highlight file differences between the specified tag
and the tip of any associated Development Branch.

=back

The four extraction points are shouwn in the following image:

     /branches/...    /tags/...
            v            v
            |
        +---+---+
  [Tag] | Work  |    +-------+
        +---+---+----+ Exact |
            |        +-------+
        +---+---+
        |       |
        +---+---+
            |
        +---+---+
        |  Tip  |
        +---+---+

=item B<-cache>

Forces external packages to be placed in the local dpkg_archive cache.

The normal operation is to copy the packages, only if they do not already exist
in the local cache. This option may be used to ensure that the local copy is
correct and up to date.

=item B<-delete[=level]>

Delete the view used by the program, if it exists. This option may be used to
cleanup after an error.

The default 'level' is 1.

If the delete level is 1, then ensure that no files are open in the view and
that the users current working directory is not in the view as these will
prevent the view from being deleted.

If the delete level is greater than one, then the view will be deleted, even
if there are checkout out files.

=item B<-debugOnly>

Make only the debug version of the package. The default it to create both the
debug and production version of the package. The type of build may be  further
limited by options within the package.

=item B<-prodOnly>

Make only the production version of the package. The default it to create both the
debug and production version of the package. The type of build may be  further
limited by options within the package.

=item B<-[no]dpkg>

Copy the generated package into dpkg_archive. This is the default mode of
operation.

=item B<-[no]copy>

Copy the built "pkg" directory to the users current directory. The entire
"pkg" subdirectory includes the full package named directory for the package
that has been built.

=item B<-[no]reuse>

This flag allows the view created by the program to be re-used.

=over 8

=item *

The view is not deleted before being populated.

=item *

The view will not be populated if it does exist.

=item *

The view will not be deleted at the end the process.

=back

This option is useful for debugging a build process.

=item B<-[no]test>

Test the building of the package. This option implies "nocopy" and "nodpkg".

=item B<-[no]keep>

Keep the workspace after the build. The default option is "nokeep"

This option is different to the "reuse" in that the view will be deleted, if
it exists, before the build, but will be retained at the completion of the
process. The user may then manually extract the created package.

The view may be deleted with the the "delete" option; taking care to ensure that
no files are open in the view and that the users current working directory is
not in the view.

=item B<-[no]beta>

This option overrides many of the package release tests to allow a beta package
to be released.

=item B<-[no]merge>

This option will merge packages being built on multiple machines into
dpkg_archive. By default, if a package already exists in the archive it will be
deleted and replaced. With this option the package will be merged. The merge
process does not over write files found in the archive.

=item B<-[no]runtests>

This option will allow the suppression of the running of the unit tests included
with the component. By default the tests are run. This can be suppressed
without affecting the release process.

=back

=head1 DESCRIPTION

This program is the primary tool for the creation, recreation and release of
packages within the B<VIX> build environment, although the program can perform a
number of very useful operations required during normal development and
maintenance.

This program will build a system containing one or more inter-related build
files using the JATS build tools.

In normal operation the program will:

=over 8

=item Remove Workspace

Remove any existing workspace of the same name. The workspace will not be
removed if it contains checked-out files.

The workspace removal may fail if there are any files B<open> within the view or if
any shell has a subdirectory of the view set as a B<current working directory>.

=item Create the workspace

Create a workspace to contain the files described by the Subversion
label being processed.

=item Populate the workspace

Loads files into the workspace.

I<Note:> If the workspace files are simply being extracted, then this is the end
of the program. The extracted workspace is left in place.

=item Sanity Test

If the build is being used as a release into dpkg_archive then
various tests are performed to ensure the repeatability of the view and the
build. These tests include:

=over 8

=item   *

The view must be constructed from one label

=item   *

That label must be pegged

=item   *

The labelled view must contain exactly one build file

=item   *

The view cannot have been re-used.

=back

=item Locate build files

Locate the build file within the view.

It is an error to have multiple build files within the workspace, unless the
B<-build> option is used. By default, only one package will be built.

=item Package the results

Use JATS to build and make the package.

The resultant package may be copied to a numbers of locations. These include

=over 8

=item 1

The master dpkg_archive as an official release. This is the default operation.

=item 2

The users current directory. The package directory from the built package is
copied locally. The "pkg" directory is copied. This is only performed with the
B<-copy> option.

=back

=item Delete the workspace

Delete the workspace and all related files.

The workspace will not be deleted if an error was detected in the build process, or
the "reuse" or "keep" options are present.

=back

=cut