Subversion Repositories DevTools

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

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : jats_rmtool.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Jats utility to support scripting

#                 Provide Release Manage information

#

# Usage         : See below

#

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

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long qw(:config require_order);     # Stop on non-option

use JatsError;

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

#   Global data

#

my $VERSION = "1.0.0";

#

#   Options

#

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

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

my $opt_help = 0;

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

# Function        : Mainline Entry Point

#

# Description     :

#

# Inputs          :

#

my $result = GetOptions (

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

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

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

                );

                #

                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!

                #

#

#   Process help and manual options

#

pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);

pod2usage(-verbose => 1) if ($opt_help == 2 );

pod2usage(-verbose => 2) if ($opt_help > 2);

#

#   Configure the error reporting process now that we have the user options

#

ErrorConfig( 'name'    =>'RMTOOL',

             'verbose' => $opt_verbose,

            );

#

#   Reconfigure the options parser to allow subcommands to parse options

#

Getopt::Long::Configure('permute');

#

#   Process command

#       First command line argument is a command

#       There will be a function named after the command

#

my $cmd = shift @ARGV || "help";

my $cmdRef;

#

#   Scan the commands symbol table for a functions of the required name

#   Done so that we can ignore case of comamnds

#

$cmd = lc $cmd;

{

    no strict "vars";

    no strict "refs";

    *stash = *{"Commands::"};  # Now %stash is the symbol table

    # Iterate through the symbol table, which contains glob values

    # indexed by symbol names.

    foreach my $varName ( keys %stash) {

        if ($cmd eq lc $varName) {

            my $globValue = $stash{$varName};

            local *alias = $globValue;

            if (defined (&alias)) {

                $cmdRef = \&alias;

                last;

            }

        }

     }

}

if (defined $cmdRef ) {

    $cmdRef->(@ARGV);

} else  {

    pod2usage(-verbose => 0, -message => "Command not known");

}

exit 0;

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

#   Package

#   Used to hide the internal functions from the wrapper

#   

package Commands;

use Getopt::Long qw(:config require_order);     # Stop on non-option

use Pod::Usage;

use JatsError;

use JatsRmApi;

use Cwd;

my $RM_DB;

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

# Function        : Help 

#

# Description     : 

#

# Inputs          : 

#

# Returns         :  

#

sub Help

{

    pod2usage(-verbose => 1);

}

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

# Function        : pkgVersion 

#

# Description     : Determine the version of a package used in a specified

#                   release

#

# Inputs          : -rtagid     - Identify the Release 

#                   -pname      - The package name    

#

# Returns         : 

#

sub pkgVersion

{

    my $opt_rtagid;

    my $opt_pname;

    my $found;

    #

    #   Parse more options

    #

    #

    ErrorConfig( 'function'    =>'pkgVersion');

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "pname=s"       => \$opt_pname,

                "rtagid=s"      => \$opt_rtagid,

                "rtag_id=s"     => \$opt_rtagid,

                ) || Error ("Invalid command line" );

    #

    #   Subcommand specific help

    #

    SubCommandHelp( $opt_help, "Package Version") if ($opt_help || $#ARGV >= 0);

    ReportError("RtagId not specified") unless defined $opt_rtagid;

    ReportError("Package Name not specified") unless defined $opt_pname;

    ErrorDoExit();

    connectDM(\$RM_DB) unless ($RM_DB);

    my $m_sqlstr = "SELECT pv.pkg_version" .

                   " FROM RELEASE_MANAGER.package_versions pv, RELEASE_MANAGER.packages p, RELEASE_MANAGER.release_content rc" .

                   " WHERE rc.rtag_id = $opt_rtagid AND pv.pv_id = rc.pv_id AND p.PKG_ID = pv.PKG_ID AND p.pkg_name = '$opt_pname'";

    my $sth = $RM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( my @row = $sth->fetchrow_array )

                {

                    print("$row[0]\n");

                    $found++;

                }

            }

            $sth->finish();

        }

        else

        {

            Error("SQL Execute failure", $m_sqlstr, $sth->errstr() );

        }

    }

    else

    {

        Error("SQL Prepare failure", $m_sqlstr, $sth->errstr() );

    }

    Error("Package '$opt_pname' not found in release" ) unless $found;

}

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

# Function        : SubCommandHelp

#

# Description     : Provide help on a subcommand

#

# Inputs          : $help_level             - Help Level 1,2,3

#                   $topic                  - Topic Name

#

# Returns         : This function does not return

#

sub SubCommandHelp

{

    my ($help_level, $topic) = @_;

    my @sections;

    #

    #   Spell out the section we want to display

    #

    #   Note:

    #   Due to bug in pod2usage can't use 'head1' by itself

    #   Each one needs a subsection.

    #

    push @sections, qw( NAME SYNOPSIS ) ;

    push @sections, qw( ARGUMENTS OPTIONS ) if ( $help_level > 1 );

    push @sections, qw( DESCRIPTION )       if ( $help_level > 2 );

    #

    #   Extract section from the POD

    #

    pod2usage({-verbose => 99,

               -noperldoc => 1,

               -sections => $topic . '/' . join('|', @sections) } );

}

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

#   Documentation

#   NOTE

#

#   Each subcommand MUST have

#   head1 section as used by the subcommand

#       This should be empty, as the contents will NOT be displayed

#   head2 sections called

#       NAME SYNOPSIS ARGUMENTS OPTIONS DESCRIPTION

#

#=head1 xxxxxx

#=head2 NAME

#=head2 SYNOPSIS

#=head2 ARGUMENTS

#=head2 OPTIONS

#=head2 DESCRIPTION

#

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

#   Documentation

#

=pod

=head1 NAME

jats rmtool - Extract RM information for scripting

=head1 SYNOPSIS

  jats rmtool command [options]

 Options:

    -help               - brief help message

    -help -help         - Detailed help message

    -man                - Full documentation

    -verbose            - Verbose operation

 Common Command Options:

    All command support suboptions to provide command specific help

    -help[=n]           - Help message, [n=1,2,3]

    -man                - Full documentation [-help=3]

 Commands are:

    pkgVersion          - Get version of named package in release

=head1 OPTIONS

=over

=item B<-help[=n]>

Print a help message and exit. The level of help may be either 1, 2 or

3 for a full manual.

This option may be specified multiple times to increment the help level, or

the help level may be directly specified as a number.

=item B<-man>

This is the same as '-help=3'.

The complete help is produced in a man page format.

=item B<-verbose[=n]>

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

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.

=back

=head1 DESCRIPTION

This program provides a number of useful Release Manager based scripting tools.

=head1 Package Version

=head2 NAME

Package Version

=head2 SYNOPSIS

    jats rmtool pkgVersion -rtagid=nnn -pname=name

=head2 DESCRIPTION

This command will print the version of the named package in the specified

release.

=head2 OPTIONS

=over

=item B<-rtagid=nnn>

This option specifies the Release Manager release to examine via its RTAG_ID.

This option is mandatory.

=item B<--pname=name>

This option specifies the package to examine, by name. The names are case-sensitive.

This option is mandatory.

=back

=cut