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 the root-dir of a package

#                       within a versioned control view

#                   +   Determine a suitable label for the package

#                   +   Save the build file in the view

#                   +   Label the resultant view

#

# Note          : Intended to be identical to jats_asave.pl

#                 except that it support SubVersion

#

# Usage:        : See POD at end of this file

#

#                 Preferred (new) usage:

#

#               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

#                   -wiplabel   Existing WIP label (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_wiplabel;

my $opt_locate;

#

#   Globals

#

my $root_dir;

my $pkg_label;

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

                "wiplabel=s"    => \$opt_wiplabel,          # string

                "locatepkg=s"   => \$opt_locate,            # string

                #

                #   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 ("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;

#

#   Locate the build directory and chdir to that directory

#

locate_build_directory();

#

#   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

#

my $session = NewSessionByWS( '.' );

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        : locate_build_directory

#

# Description     : Locate the build directory that contains the build files

#                   In an ANT build, this will e the root of the package

#                   Otherwise the build files may not be in the root directory

#

#

# Inputs          : Globals

#

# Returns         : Globals

#

sub locate_build_directory

{

    return unless ( $opt_locate );

    my $bscanner = BuildFileScanner ( '.', $opt_infile );

    my $count = $bscanner->locate();

    Error ("Autolocate. Build file not found: $opt_infile" )

        if ( $count <= 0 );

    #

    #   If multiple build files have been found

    #   Scan the buildfiles and determine the names of the packages that will

    #   be built. This can be used to generate nice error messages

    if ( $count > 1 )

    {

        $bscanner->scan();

        $count = $bscanner->match( $opt_locate );

        my $errmess;

        if ( $count <= 0 ) {

            $errmess = "None found that build package: $opt_locate";

        } elsif ( $count > 1 ) {

            $errmess = "Multiple build files build the required package: $opt_locate";

        }

        #

        #   Pretty error display

        #   Display build directory and the package name (mangled)

        #

        if ( $errmess )

        {

            Error ("Autolocate. Multiple build files found.",

                   $errmess,

                   "Build files found in:", $bscanner->formatData() );

        }

    }

    #

    #   Extract the required build file directory

    #

    my $dir = $bscanner->getMatchDir() || '';

    Verbose ("Autolocate. Found $count build files: $dir");

    #

    #   Select the one true build directory

    #

    if ( $dir ne '.' )

    {

        #

        #   Save the current directory for later

        #

        $root_dir = getcwd();

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

    }

}

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

# 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

#                       $pkg_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

    #

    unless ( $opt_wiplabel )

    {

        $pkg_label = $tag_label;

    }

    else

    {

        $pkg_label = $opt_wiplabel;

    }

}

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

# 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

{

    #

    #   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',

               );

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

    if ( $opt_wiplabel )

    {

        #

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

        #   WIP if its based on a branch

        #

        if ( $session->WsType eq 'branches' )

        {

            $session->SvnDelete(

                    'target'  => $session->FullWs,

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

                    'noerror' => 1,

                     );

        }

        else

        {

            Message ("WIP not deleted.","Will not delete WIPS based on a :" . $session->WsType );

        }

    }

    #

    #   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_wiplabel ) if $opt_wiplabel;

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

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

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

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

        $data->store( $opt_infofile );

    }

}

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

#   Documentation

#

=pod

=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

    -locatepkg=text     - Package locator string

    -wiplabel=text      - Current package WIP label

=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<-locatepkg=text>

This option specifies a name, by which the package's build files may be located.

This is only needed for JATS builds and will only be used to resolve the

location of build files when a package contains multiple build files.

=item B<-wiplabel=text>

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   3) WipLabel - The WIP label provided (optional)

=item   4) PackageName - The package name

=item   5) PackageVersion - The package version

=back

=back

=cut