Subversion Repositories DevTools

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

# Copyright ( C ) 2008 ERG Limited, All rights reserved

#

# Module name   : jats_svnasave_build.pl

# Module type   : JATS Utility

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Build Daemon Support Utility

#                 This utility will:

#                   +   Assume the CWD is where the build file is located

#                   +   Within a version controlled view

#                   +   Determine a suitable label for the package

#                   +   Save the build file in the view

#                   +   Label the resultant view

#

# Usage:        : See POD at end of this file

#

#               jats etool  jats_svnasave_build

#                   -infile     auto.xml/auto.pl

#                   -outfile    xxxdepends.xml/build.pl

#                   -pname      package_name

#                   -pversion   package_version

#                   -infofile   path_to_info_file

#                   -baselabel  View label

#                   -isawip     Is A WIP (optional)

#

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

use strict;

use warnings;

use JatsError;

use JatsBuildFiles;

use JatsSystem;

use JatsProperties;

use Getopt::Long;

use Pod::Usage;                             # required for help support

use File::Copy;

use JatsSvn;

use Cwd;

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

#   Option variables

#

my $VERSION = "2.0.0";                      # Update this

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_infile  = "auto.pl";

my $opt_ofile = "build.pl";

my $opt_help = 0;

my $opt_infofile;

my $opt_pname;

my $opt_pversion;

my $opt_baselabel;

my $opt_isa_wip;

#

#   Globals

#

my $root_dir;

my $tag_label;

my $ws_root;

my $pkg_root;

#

#   Configuration options

#

my $result = GetOptions (

                "help:+"        => \$opt_help,              # flag, multiple use allowed

                "manual:3"      => \$opt_help,              # flag

                "verbose:+"     => \$opt_verbose,           # flag

                "outfile=s"     => \$opt_ofile,             # string

                "infile=s"      => \$opt_infile,            # string

                "infofile=s"    => \$opt_infofile,          # string

                "pname=s"       => \$opt_pname,             # string

                "pversion=s"    => \$opt_pversion,          # string

                "baselabel=s"   => \$opt_baselabel,         # string

                "isawip:+"      => \$opt_isa_wip,           # Flag

                #

                #   Update documentation at the end of the 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'    =>'SVNABTSAVE',

             'verbose' => $opt_verbose,

           );

Error ("Input and output file are the same: $opt_infile" )

    if ( $opt_infile eq $opt_ofile );

Error ("Base Label not provided")

    unless ( $opt_baselabel );

Error ("Package Name not provided")

    unless ( $opt_pname );

Error ("Package Version not provided")

    unless ( $opt_pversion );

Warning("Path to info file not provided")

    unless ( $opt_infofile );

unlink ($opt_infofile) if $opt_infofile;

#

#   User must have changed to the directory with build files

#   Continue with user argument sanity check

#

Error ("Input file not found: $opt_infile" )

    unless ( -f $opt_infile );

Error ("Output file not found: $opt_ofile" )

    unless ( -f $opt_ofile );

#

#   Create a SubVersion Session using the current workspace

#   as a basis. Error if not a workspace

#

#   Need abs path so that we can correctly detect modified build files

#

my $sessionRoot = getcwd();

my $session = NewSessionByWS( $sessionRoot );

Verbose ("Determine the current workspace root" );

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

$pkg_root = $session->Full;

Verbose ("Workspace root: $ws_root");

Verbose ("Package root  : $pkg_root");

#

#   Determine the desired label for the package

#   May need to pick an unassigned label

#

determine_package_label();

#

#   Update the build file

#   Under subversion this is a simple 'copy'

#

Verbose ("Update build files");

unlink $opt_ofile;

unless ( File::Copy::copy($opt_infile, $opt_ofile) )

{

    Error("Failed to copy file [$opt_infile] to [$opt_ofile]: $!");

    Error ("Updating build files","Reason: $!");

}

#

#   Change back to original directory

#

if ( $root_dir )

{

    chdir $root_dir || Error ("Cannot change directory: $root_dir");

}

#

#   Label the view

#

label_build_view();

exit 0;

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

# Function        : determine_package_label

#

# Description     : Determine the label that is to be applied to the package

#                   There are several cases to consider

#                       1) Compatability mode: User provides label

#                       2) WIP Mode. Determine name of label to use in rename

#                       3) Create a new label

#

# Inputs          : Globals

#

# Returns         : Globals

#                       $tag_label

#

sub determine_package_label

{

    #

    #   Determine the desired label for the package

    #   This is a function of the package name and the package version

    #   The two are joined with a '.'

    #

    $tag_label = $opt_pname . '_' . $opt_pversion;

    #

    #   Ensure that desired label is "free", if not then hunt for a new one

    #   Determine the name of a 'new' label

    #

    my $base_label = $tag_label;

    my $index = 0;

    while ( ++$index )

    {

        if ( $index > 20 )

        {

            Error ("Cannot determine new label. Retry limit exceeded");

        }

        Verbose2 ("Trying $tag_label");

        if ( $session->SvnValidateTarget (

                    'target' => $session->BranchName($tag_label, 'tags' ),

                    'test' => 1,

                    ))

        {

            #

            #   Label found - so try another

            #

            Verbose2("Label found. Try another");

            $tag_label = $base_label . '.' . $index;

            next;

        }

        #

        #   Warn about non standard label

        #

        Verbose ("Package will be labeled: $tag_label");

        Warning ("Labeling with a non-standard label: $tag_label" )

            if ( $index > 1 );

        last;

    }

    #

    #   Free label has been found

    #

}

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

# Function        : label_build_view

#

# Description     : Label the view

#

#                   Either:

#                       Rename the WIP label to required name

#                       Label all files in the view

#                   

#                   Use JATS to do the hard work

#

#

# Inputs          : Globals

#

# Returns         : 

#

sub label_build_view

{

    my $author;

    #

    #   Determine the author of the workspace - before we update it

    #   The original author will be used to mark the work in the repo

    #   This better describes the task done

    #

    $author = $session->{'InfoWs'}{'Last Changed Author'};

    Error ("Internal: Svn Session data item 'InfoWs' not present")

        unless ( defined $author );

    #

    #   Save the current workspace - with its modified build file

    #

    Verbose ("Apply new label to package: $tag_label");

    $session->SvnCopyWs (

               'target'         => $session->BranchName($tag_label, 'tags' ),

               'modified'       => $opt_ofile,

               'noswitch'       => 1,

               'replace'        => 0,

               'comment'        => 'Created by Jats SaveBuild',

               'noupdatecheck'  => 2,

               );

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

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

    #

    #   Update the svn:author of the workspace rather than 'buildadm'

    #   Allow badly configured repos. Don't fail if can't update the author

    #

    Verbose ("Author: $author");

    $session->setRepoProperty('svn:author', $author, 1);

    if ( $opt_isa_wip )

    {

        Verbose( 'Is a WIP');

        Verbose( '$session->WsType: ', $session->WsType);

        Verbose( '$opt_baselabel: ', $opt_baselabel);

        #

        #   If the build is based on a WIP then we can delete the WIP

        #   tag under the following conditions:

        #       It is a true tag - and not a 'peg'

        #       It is a true WIP - and not a copy of another label

        #                          ie: Ends in .WIP - with possible peg

        #

        if ( $opt_baselabel =~ m~(.+)::(.+)~ )

        {

            my $baseTag = $2;

            if ( $baseTag =~ m~\.WIP(\@\d+)?$~)

            {

                $session->SvnDelete(

                        'target'  => $session->FullPath . '/tags/' . $baseTag,

                        'comment' => ["Deleted by Jats SaveBuild","Replaced by: $tag_label"],

                        'noerror' => 1,

                         );

            }

            else

            {

                Message ("WIP not deleted.","Will not delete WIPS of this type:" . $opt_baselabel );

            }

        }

        else

        {

            Message ("WIP not deleted.","Cannot parse baselabel: " . $opt_baselabel );

        }

    }

    #

    #   Write the label out to the specified file so that the user

    #   can do something with it

    #

    if ( $opt_infofile )

    {

        my $data = JatsProperties::New();

        $data->setProperty('Label', $tag_label);

        $data->setProperty('WipLabel', $opt_baselabel) if $opt_isa_wip;

        $data->setProperty('PackageName', $opt_pname);

        $data->setProperty('PackageVersion', $opt_pversion);

        $data->setProperty('subversion.tag', $session->RmRef);

        $data->setProperty('VCS.tag', 'SVN::' . $session->SvnTag);

        $data->Dump('InfoFile') if ($opt_verbose);

        $data->store( $opt_infofile );

    }

}

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

#   Documentation

#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

jats_svnsave_build - Save a build view to version control system

=head1 SYNOPSIS

  jats etool jats_save_build [options]

 Options:

    -help[=n]           - brief help message

    -help -help         - Detailed help message

    -man[=n]            - Full documentation

    -verbose[=n]        - Verbose operation

    -infile=xxx         - Input file (auto.pl)

    -outfile=xxx        - Output file (build.pl)

    -infofile=path      - Save label information in 'path'

    -pname=name         - Name of the package

    -pversion=text      - Package version

    -baselabel=text     - Base label for sandbox

    -isawip             - Current package is a WIP

=head1 OPTIONS

=over 8

=item B<-help[=n]>

Print a brief help message and exits.

The verbosity of the help text can be controlled by setting the help level to a

number in the range of 1 to 3, or by invoking the option multiple times.

=item B<-man[=n]>

Without a numeric argument this is the same as -help=3. Full help will be

displayed.

With a numeric argument, this option is the same as -help=n.

=item B<-verbose[=n]>

This option will increase the level of verbosity of the utility.

If an argument is provided, then it will be used to set the level, otherwise the

existing level will be incremented. This option may be specified multiple times.

=item B<-infile=xxxx>

This option specifies the name of the generated build configuration file that

will be used as a data-source for the check-in build file.

The default file name is 'auto.pl'.

=item B<-outfile=xxxx>

This option specifies the name of the target build configuration file that

will be checked in to version-control. Data from from file specifies with '-

infile' will be used to update the file.

The default file name is 'build.pl'.

=item B<-infofile=path>

This option specifies a file that this utility will use to communicate with a

user script. It will write the new label text into the file.

The file path is relative to the current working directory.

The file will be deleted, and only created if the utility is successful.

=item B<-pname=name>

This option specifies the package name. It will be used to construct a new

label for the package.

=item B<-pversion=xxx>

This option specifies the package version. It will be used to construct a new

label for the package.

=item B<-baselabel=text>

This option specifies the Version Control Label that the current workspace

is based on. This may be used to determine the new label for the package.

This parameter is mandatory.

=item B<-isawip>

This option controls the manner in which this utility will label the build view.

If present, the label specifies a 'Work In Progress' label. The label will be

renamed. At the end of the process the wip label will be deleted from the

the repository.

If not present, then the view will be labeled with a new label.

=back

=head1 DESCRIPTION

This utility is used by the automated build system to place build view under

version control. The utility will:

=over 8

=item *

Determine a suitable label for the package

The label is constructed from the package name and the package version. The

utility will ensure that the label does not already exist. If it does it will

use an alternate form of the label.

=item *

Locate the build files within the package

JATS build files do not need to be at the root of the package. The utility

will locate the JATS build files.

=item *

Update the build files and save them into the version control system

The build file will be updated with new version information as provided by a

secondary configuration file.

The updated file will be checked into version control.

=item *

Ensure that the package is labeled

The build view will be labeled (tagged).

If a WIP label is provided then the WIP label will be removed if it is a branch.

=item *

Return the label to the user

The label used to label the package will be returned to the user in an 'info'

file. This is a 'properties' file. The following properties are defined:

=over 8

=item 1

Label - The label used to tag the file

=item 2

PackageName - The package name

=item 3

PackageVersion - The package version

=back

=back

=cut