Subversion Repositories DevTools

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

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

#

# Module name   : jats_vars.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Program to show the environment variables passed into

#                 a program invoked by JATS

#

# Usage:        jats vars

#

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

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long;

use Cwd;

use JatsError qw(:name=JatsVars);

#

#   Local variables

#

my $VERSION = "1.0.0";                      # Update this

my $opt_verbose = $ENV{'GBE_VERBOSE'} || 0;

my $opt_help = 0;

my $indent = 17;

my @indents;

my $GBE_UNIX = $ENV{GBE_UNIX} || 0;

my $CWD;

my $PSPLIT;

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

# Function        : Main Entry

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

my $result = GetOptions (

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

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

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

                );

#

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

#

#   Init some useful variables

#

$CWD = getcwd();

$PSPLIT = $GBE_UNIX ? ':' : ';';                               # Win/Unix path splitter

if ( $opt_verbose > 1 ) {

    dump_full();

} else {

    dump_vars();

}

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

# Function        : display functions

#

# Description     : 

#

# Inputs          : 

#

# Returns         : 

#

#   Display an array separated list, one entry per line, with dir sanity check

sub alist

{

    my ($text, @var) = @_;

    my $sep = "=";

    for ( @var )

    {

        my $valid = ( -d $_ || -f $_ ) ? " " : "*";

        printf "%-${indent}s%s%s%s\n", $text, $sep, $valid, $_;

        $text = "";

        $sep = " ";

    }

}

# Simple print of name and variable

sub pvar

{

    my ($text, $data) = @_;

    $data =~ s~\n~\\n~g;

    printf "%-${indent}s= %s\n", $text, $data;

}

# Print of name and variable of directory with sanity check

sub dvar

{

    my ($text, $data) = @_;

    my $valid = ( ! $data || -d $data || -f $data ) ? " " : "*";

    printf "%-${indent}s=%s%s\n", $text, $valid, $data;

}

# Display a variable extracted from the environment

sub penv

{

    my ($var) = @_;

    pvar $var, $ENV{$var} || '';

}

# Display a variable extracted from the environment with dir sanity check

sub denv

{

    my ($var) = @_;

    dvar $var, $ENV{$var} || '';

}

#   Display a ';' or ':' separated list, one entry per line based on EnvVar

sub lenv

{

    my ($var) = @_;

    alist( $var, split $PSPLIT, $ENV{$var} || " " );

}

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

# Function        : dump_full

#

# Description     : Display ALL EnvVars

#

# Inputs          : 

#

# Returns         : 

#

sub dump_full

{

    Message ("Complete environment dump");

    $indent = 33;

    foreach my $var ( sort keys(%ENV) )

    {

        penv ($var);

    }

    return;

}

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

# Function        : dump_vars

#

# Description     : Dump selected environment varaibles

#

# Inputs          : 

#

# Returns         : 

#

sub dump_vars

{

    #

    #   Complete environment dump

    #

    if ( $opt_verbose > 1 )

    {

    }

    #

    #   Partial dump

    #   Display selected parts

    #

    penv    "GBE_VERSION";

    penv    "GBE_SCRIPT";

    penv    "GBE_DEBUG";

    penv    "GBE_VERBOSE";

    if ( $opt_verbose )

    {

        penv    "GBE_JATS_VERSION";

        penv    "GBE_JATS_SANE";

    }

    penv    "GBE_MACHTYPE";

    penv    "GBE_HOSTMACH";

    penv    "GBE_UNIX";

    penv    "GBE_DRV";

    denv    "GBE_PERL";

    denv    "GBE_CORE";

    denv    "GBE_BIN";

    denv    "GBE_TOOLS";

    denv    "GBE_CONFIG";

    penv    "GBE_CACHE_JATS";

    lenv    "GBE_SANDBOX";

    lenv    "GBE_DPKG_STORE";

    lenv    "GBE_DPKG";

    lenv    "GBE_DPKG_CACHE";

    lenv    "GBE_DPKG_LOCAL";

    lenv    "GBE_DPKG_SBOX";

    lenv    "GBE_DPLY";

    penv    "GBE_PLATFORM";

    penv    "GBE_BUILDFILTER";

    penv    "GBE_ABT";

    denv    "GBE_VIEWBASE";

    penv    "GBE_VCS";

    penv    "GBE_HOSTNAME";

    dvar    "CWD", $CWD;

    penv    "COMSPEC";

    penv    "SHELL";

    penv    "USER";

    lenv    "PATH";

    #

    #   Display variables used by various "known" toolsets

    #   These do cause grief sometime, so only do it for verbose

    #

    if ( $opt_verbose )

    {

        print "\nPerl Environment\n";

        pvar  "VERSION"         ,$];

        penv  "PERL5SHELL";

        penv  "PERL5OPT";

        lenv  "PERL5LIB";

        alist "INC"             ,@INC;

        print "\nJava Environment\n";

        foreach my $var ( sort grep ( {/^JAVA_HOME/ } keys %ENV) )

        {

            denv  $var;

        }

        denv  "ANT_HOME";

        denv  "JATS_HOME";

        lenv  "CLASSPATH";

    }

    if ( $opt_verbose || $ENV{GBE_ABT} )

    {

        print "\nRelease Manager Environment\n";

        penv    "GBE_RM_LOCATION";

        penv    "GBE_RM_USERNAME";

        penv    "GBE_RM_PASSWORD";

        penv    "GBE_RM_URL";

        penv    "GBE_DM_LOCATION";

        penv    "GBE_DM_USERNAME";

        penv    "GBE_DM_PASSWORD";

        penv    "GBE_DM_URL";

    }

    if ( $opt_verbose || $ENV{GBE_SVN_USERNAME} || $ENV{GBE_SVN_PATH} )

    {

        print "\nSubVersion\n";

        denv    "GBE_SVN_PATH";

        penv    "GBE_SVN_USERNAME";

        penv    "GBE_SVN_PASSWORD";

        print "\nSubVersion Repository Paths\n";

        push @indents, $indent;

        $indent = 24;

        foreach ( sort keys %ENV )

        {

            penv    $_ if ( m ~^GBE_SVN_URL~ );

        }

        $indent = pop @indents;

    }

    if ( $opt_verbose && ! $GBE_UNIX)

    {

        print "\nWindows Environment\n";

        denv  "TEMP";

        denv  "TMP";

        print "\nMicrosoft Studio Variables\n";

        denv  "PROGRAMFILES";

        denv  "WINDIR";

        denv  "MSVCDir";

        print "\nMicroTec Compiler Variables\n";

        denv "MRI_68K";

        denv "MRI_CF";

        denv "VISIONCLICK";

        print "\nPCLint Variables\n";

        denv "PCLINT";

        penv "LINTPACKAGE";

    }

}

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

#   Documentation

#

=pod

=head1 NAME

vars - Display Jats Related Environment Variables

=head1 SYNOPSIS

  jats vars [options]

 Options:

    -help              - brief help message

    -help -help        - Detailed help message

    -man               - Full documentation

    -verbose[=n]       - Verbose operation

=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.

This is the same as -help=3.

=item B<-man[=n]>

Set the help level directly. Valid values are 0,1,2 and 3.

=item B<-verbose[=n]>

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

The allowed verbosity levels are:

=over 4

=item 0

Basic variable display

=item 1

Display additional JATS related information.

=item 2

Display all the Environment variables.

=back

=back

=head1 DESCRIPTION

This program will display the values of all JATS related L<environment

variables|POD::EnvVars>.

Many of the variables will be displayed with sanity information. If the

variable is a PATH and and the PATH does not exist, then the displayed value

will be prefixed with a '*'

=cut