# Column 4 ClearCase Version (if applicable)
# Column 5 Owner (if known)
# Column 6 Usage (if known)
-#oldIFS=$IFS
-#IFS=":"
+oldIFS=$IFS
+IFS=":"
declare -i nbr_of_machines=0
-#sed -e "/^#/d" $machines |
-while read machine; do
+IFS=:
+while read machine model os cc owner usage; do
machines[nbr_of_machines]=$machine
let nbr_of_machines=nbr_of_machines+1
done < <(grep -v ^# $machines)
export currmachine=${machines[i]}
# Execute command. Note if no command is given then the effect is to
# ssh to each machine.
- echo -e "${CYAN}${machines[i]}$NORMAL\c"
+ echo -e "${B_AQUA}${machines[i]}$NORMAL\c"
echo -e ":$cmd"
if [ $# -gt 0 ]; then
if [ "$root_ssh" = "true" ]; then
[-use|rname <username>] [-p|assword <password>]
[-log]
-m|achines <host1>,<host2>,...
-
+
<command>
Where:
TODO: Is cleartool find really needed? I mean since we are going through
the extended version namespace don't we by default find all
subdirectories?
-
+
This script will use cleartool find to process all directory elements from
$startingDir (Default '.'). For each version of the directory a hash will be
built up containing all of the element names in that directory version.
$log->msg ("File: $filename");
foreach (@oids) {
- $log->msg ("\tOID: $$_{OID} ($$_{count})");
- $log->msg ("\tFirst detected \@: $$_{version}");
+ $log->msg ("\tOID: $$_{OID} ($$_{count})");
+ $log->msg ("\tFirst detected \@: $$_{version}");
} # foreach
} # if
} # foreach
if $directory eq '.';
my $displayName = "$directory$Clearcase::SFX$version";
-
+
# We only want to deal with branches and numbered versions. Non-numbered
# versions which are not branches represent labels and baselines which are
# just aliases for directory and file elements. Branches represent recursion
last;
} # if
} # foreach
-
+
unless ($found) {
# If we didn't find a match then make a new %objInfo starting with a
# count of 1. Also save this current $version, which is the first
close $dirs
or $log->err ("Unable to close $cmd - $!");
-
+
return $total{'evil twins'};
} # processDirs
+++ /dev/null
-################################################################################
-#
-# File: testcc.conf
-# Revision: 2.0
-# Description: Parameters for testcc
-#
-# Author: Andrew@DeFaria.com
-# Created: Thu Sep 6 14:05:55 MST 2007
-# Modified:
-# Language: Conf
-#
-# (c) Copyright 2007, Andrew@DeFaria.com, all rights reserved.
-#
-#################################################################################
-vobhost: gdvob1
-vobpath: /net/$vobhost
-vobstore: $vobpath/local/gdvob1a
-
-viewhost: view1
-viewpath: /net/$viewhost
-viewstore: $viewpath/local/view1a
\ No newline at end of file
+++ /dev/null
-#!/bin/bin/perl
-
-=pod
-
-=head1 NAME $RCSfile: testcc.pl,v $
-
-Test Clearcase
-
-=head1 VERSION
-
-=over
-
-=item Author
-
-Andrew DeFaria <Andrew@ClearSCM.com>
-
-=item Revision
-
-$Revision: 1.6 $
-
-=item Created:
-
-Tue Apr 10 13:14:15 CDT 2007
-
-=item Modified:
-
-$Date: 2011/01/09 01:01:32 $
-
-=back
-
-=head1 SYNOPSIS
-
- Usage testcc.pl: [-u|sage] [-ve|rbose] [-d|ebug]
- [-c|onfig <file>] [-vi|ewstore <viewstore>]
- [-vo|bstore <vobstore>]
-
- Where:
- -u|sage: Displays usage
-
- -ve|rbose: Be verbose
- -d|ebug: Output debug messages
-
- -c|onfig <file>: Config file (Default: testcc.conf)
- -vi|ewstore: Path to view storage area
- -vo|bstore: Path to vob storage area
-
-=head1 DESCRIPTION
-
-Clearcase smoke tests. Perform simple Clearcase operations to validate that
-Clearcase minimally works
-
-=cut
-
-use strict;
-use warnings;
-
-use FindBin;
-use Getopt::Long;
-use Cwd;
-use Term::ANSIColor qw(:constants);
-
-my $libs;
-
-BEGIN {
- $libs = $ENV{SITE_PERLLIB} ? $ENV{SITE_PERLLIB} : "$FindBin::Bin/../lib";
-
- die "Unable to find libraries\n"
- unless -d $libs;
-} # BEGIN
-
-use lib $libs;
-
-use Clearcase;
-use Clearcase::Element;
-use Clearcase::View;
-use Clearcase::Views;
-use Clearcase::Vob;
-use Clearcase::Vobs;
-use DateUtils;
-use Display;
-use GetConfig;
-use Logger;
-use OSDep;
-use Utils;
-
-# Globals
-my $VERSION = '2.0';
-
-my ($vbs, $vws, %default_opts, %opts);
-
-my $log = Logger->new;
-my $view = $Clearcase::VIEWTAG_PREFIX;
-my $view_tag = $FindBin::Script;
-my $vob = $ENV{TMP} ? $ENV{TMP} : "/tmp"; # Private vob - mount to /tmp!
-my $vob_tag = $view_tag;
-
-my ($test_view, $test_vob);
-
-# LogOpts: Log the %opts has to the log file so we can tell the options used for
-# this run.
-sub LogOpts () {
- $log->msg (
- "$FindBin::Script v$VERSION run at "
- . YMDHM
- . " with the following options:"
- );
-
- foreach (sort keys %opts) {
- if (ref $opts{$_} eq "ARRAY") {
- my $name = $_;
- $log->msg ("$name:\t$_") foreach (@{$opts{$_}});
- } else {
- $log->msg ("$_:\t$opts{$_}");
- } # if
- } # foreach
-
- return;
-} # LogOpts
-
-sub CreateVob () {
- $log->msg ("Creating vob $vob/$vob_tag");
-
- $test_vob = Clearcase::Vob->new ("$vob/$vob_tag");
-
- my ($status, @output) = $test_vob->create ($opts{vobhost}, $vbs);
-
- $log->log ($_) foreach (@output);
-
- if ($status != 0) {
- if ($output[0] =~ /already exists/) {
- $log->warn ("Vob " . $test_vob->tag . " already exists");
- return 0;
- } # if
- } # if
-
- return $status;
-} # CreateVob
-
-sub MountVob () {
- $log->msg ("Mounting vob " . $test_vob->tag);
-
- # Create mount directory
- my ($status, @output) = Execute "mkdir -p " . $test_vob->tag . " 2>&1";
-
- $log->log ($_) foreach (@output);
-
- ($status, @output) = $test_vob->mount;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # MountVob
-
-sub DestroyVob () {
- my ($status, @output);
-
- ($status, @output) = $Clearcase::CC->execute ("cd");
-
- $log->msg ("Unmounting vob " . $test_vob->tag);
-
- ($status, @output) = $test_vob->umount;
-
- $log->msg ("Removing vob " . $test_vob->tag);
-
- ($status, @output) = $test_vob->remove;
-
- $log->log ($_) foreach (@output);
-
- ($status, @output) = Execute "rmdir " . $test_vob->tag;
-
- $log->log ($_)
- foreach (@output);
-
- return $status;
-} # DestroyVob
-
-sub CreateView () {
- $log->msg ("Creating view $view_tag");
-
- $test_view = Clearcase::View->new ($view_tag);
-
- my ($status, @output) = $test_view->create ($opts{viewhost}, $vws);
-
- $log->log ($_) foreach (@output);
-
- if ($status != 0) {
- if ($output[0] =~ /already exists/) {
- $log->warn ("View " . $test_view->tag . " already exists");
- return 0;
- } # if
- } # if
-
- return $status;
-} # CreateView
-
-sub SetView () {
- $log->msg ("Setting view $test_view->tag");
-
- my ($status, @output) = $test_view->set;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # SetView
-
-sub DestroyView () {
- $log->msg ("Removing view " . $test_view->tag);
-
- my ($status, @output) = $Clearcase::CC->execute ("cd");
-
- $log->log ($_) foreach (@output);
-
- chdir $ENV{HOME}
- or $log->err ("Unable to chdir $ENV{HOME}", 1);
-
- ($status, @output) = $test_view->remove;
-
- $log->log ($_) foreach (@output);
-
- return $status;
-} # DestroyView
-
-sub CreateViewPrivateFiles (@) {
- my (@elements) = @_;
-
- $log->msg ("Creating test files");
-
- foreach (@elements) {
- my $file;
-
- $log->msg ("Creating $_");
-
- open $file, ">>", $_
- or $log->err ("Unable to open $_ for writing - $!", 1);
-
- print $file "This is file $_\n";
-
- close $file;
- } # foreach
-
- return;
-} # CreateViewPrivateFiles
-
-sub CheckOut ($) {
- my ($element) = @_;
-
- my ($status, @output);
-
- if (ref $element eq "ARRAY") {
- foreach (@{$element}) {
- $log->msg ("Checking out $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- ($status, @output) = $newElement->checkout;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check out $_", $status) if $status;
- } # foreach
- } else {
- $log->msg ("Checking out $element");
-
- my $newElement = Clearcase::Element->new ($element);
-
- ($status, @output) = $newElement->checkout;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check out $element", $status) if $status;
- } # if
-
- return;
-} # CheckOut
-
-sub CheckIn ($) {
- my ($element) = @_;
-
- my ($status, @output);
-
- if (ref $element eq "ARRAY") {
- foreach (@{$element}) {
- $log->msg ("Checking in $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- ($status, @output) = $newElement->checkin;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check in $_", $status) if $status;
- } # foreach
- } else {
- $log->msg ("Checking in $element");
-
- my $newElement = Clearcase::Element->new ($element);
-
- ($status, @output) = $newElement->checkin;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to check in $element", $status) if $status;
- } # if
-
- return;
-} # CheckIn
-
-sub ComparingFiles (@) {
- my (@elements) = @_;
-
- foreach (@elements) {
- my @lines = ReadFile $_;
-
- $log->err ("Element $_ should contain only two lines", 2) if scalar @lines != 2;
- } # foreach
-
- return;
-} # ComparingFiles
-
-sub MakeElements (@) {
- my (@elements) = @_;
-
- foreach (@elements) {
- $log->msg ("Mkelem $_");
-
- my $newElement = Clearcase::Element->new ($_);
-
- my ($status, @output) = $newElement->mkelem;
-
- $log->log ($_) foreach (@output);
- $log->err ("Unable to make $_ an element", $status) if $status;
- } # foreach
-
- return;
-} # MakeElements
-
-sub RunTests () {
- # Simple tests:
- #
- # . Create a few elements
- # . Check them in
- # . Check them out
- # . Modify them
- # . Check them in
- #
- # Assumptions:
- #
- # . $vob_tag is already created
- # . $view_tag is already created
- # . View is set and we are in the vob
- # . There are no vob elements for @elements
- my @elements = (
- "cctest.h",
- "ccsetup.c",
- "cctest.c",
- "Makefile",
- );
-
- $log->msg ("Removing test files");
-
- unlink $_ foreach (@elements);
-
- $log->msg ("Creating view private files");
-
- CreateViewPrivateFiles $log, @elements;
-
- $log->msg ("Making elements");
-
- CheckOut '.';
- MakeElements @elements;
- CheckIn \@elements;
- CheckIn '.';
-
- $log->msg ("Checking out files");
-
- CheckOut \@elements;
-
- $log->msg ("Modifying files");
-
- CreateViewPrivateFiles @elements;
-
- $log->msg ("Checking in files");
-
- CheckIn \@elements;
-
- $log->msg ("Comparing files");
-
- ComparingFiles @elements;
-
- $log->msg ("$FindBin::Script: End Tests");
-
- return 0;
-} # RunTests
-
-sub Cleanup () {
- my $status = 0;
-
- $log->msg ("Cleaning up");
-
- if ($test_view && $test_view->exists) {
- $status += DestroyView;
- } # if
-
- if ($test_vob && $test_vob->exists) {
- $status += DestroyVob;
- } # if
-
- return $status;
-} # Cleanup
-
-sub SetupTest () {
- $log->msg ("Setup test environment");
-
- my $status += CreateVob;
-
- return $status if $status != 0;
-
- $status += MountVob;
-
- return $status if $status != 0;
-
- $status += CreateView;
-
- return $status if $status != 0;
-
- $status += $test_view->start;
-
- my $dir = $Clearcase::VIEWTAG_PREFIX . $test_view->tag . $test_vob->tag;
-
- chdir $dir
- or $log->err ("Unable to chdir to $dir", $status++);
-
- my @output;
-
- ($status, @output) = $Clearcase::CC->execute ("cd $dir");
-
- if ($status != 0) {
- $log->log ($_) foreach (@output);
- $log->err ("Unable to chdir to $dir", $status);
- } # if
-
- return $status;
-} # SetupTest
-
-my $conf_file = "$FindBin::Script.conf";
-
-GetOptions (
- \%opts,
- "v|verbose" => sub { set_verbose },
- "u|usage" => sub { Usage },
- "c|onfig=s",
- "n|etpath=s",
- "viewstore=s",
- "vobstore=s",
-) or Usage;
-
-# Read the config file
-if (-f $conf_file) {
- %default_opts = GetConfig $conf_file;
-} else {
- $log->err ("Unable to find config file $conf_file", 1);
-} # if
-
-# Overlay default opts if not specified
-foreach (keys %default_opts) {
- $opts{$_} = $default_opts{$_} if !$opts{$_};
-} # foreach
-
-$vws = "$opts{viewstore}/$view_tag.vws";
-$vbs = "$opts{vobstore}/$vob_tag.vbs";
-
-$log->msg ("START: $FindBin::Script (v$VERSION)");
-
-LogOpts;
-
-my $status = SetupTest;
-
-if ($status == 0) {
- $status += RunTests;
-} else {
- $log->err ("Tests not run. Failure occured in SetupTest - check logfile");
-} # if
-
-$status += Cleanup;
-
-if ($status != 0) {
- $log->err ("$FindBin::Script failed");
-} else {
- $log->msg ("$FindBin::Script passed");
-} # if
-
-$log->msg ("END: $FindBin::Script (v$VERSION)");
-
-exit $status;
-
-=pod
-
-=head1 CONFIGURATION AND ENVIRONMENT
-
-DEBUG: If set then $debug is set to this level.
-
-VERBOSE: If set then $verbose is set to this level.
-
-TRACE: If set then $trace is set to this level.
-
-=head1 DEPENDENCIES
-
-=head2 Perl Modules
-
-L<Cwd>
-
-L<FindBin>
-
-L<Getopt::Long|Getopt::Long>
-
-L<Term::ANSIColor|Term::ANSIColor>
-
-=head2 ClearSCM Perl Modules
-
-=begin man
-
- Clearcase
- Clearcase::Element
- Clearcase::View
- Clearcase::Views
- Clearcase::Vob
- Clearcase::Vobs
- DateUtils
- Display
- GetConfig
- Logger
- OSDep
- Utils
-
-=end man
-
-=begin html
-
-<blockquote>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Element.pm">Element</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">View</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Views.pm">Views</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vob.pm">Vob</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vobspm">Vobs</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Logger.pm">Logger</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/OSDep.pm">OSDep</a><br>
-<a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
-</blockquote>
-
-=end html
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in this script
-
-Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-
-=cut
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use FindBin;
+use Term::ANSIColor qw(:constants);
+
+use lib "$FindBin::Bin/../lib";
+
+use Clearcase;
+use Display;
+
+my ($status, @output) = $Clearcase::CC->execute ('pwv');
+
+error 'Clearcase is not installed on this system', 1
+ if $status;
+
+display YELLOW . "Global Clearcase Variables\n" . RESET;
+
+my $view_drive = $Clearcase::VIEW_DRIVE;
+my $vob_mount = $Clearcase::VOB_MOUNT;
+my $win_vob_prefix = $Clearcase::WIN_VOB_PREFIX;
+my $vobtag_prefix = $Clearcase::VOBTAG_PREFIX;
+my $countdb = $Clearcase::COUNTDB;
+
+display MAGENTA . "View Drive:\t\t" . RESET . $view_drive;
+display MAGENTA . "VOB Mount:\t\t" . RESET . $vob_mount;
+display MAGENTA . "Windows VOB prefix:\t" . RESET . $win_vob_prefix;
+display MAGENTA . "VOB Tag Prefix:\t\t" . RESET . $vobtag_prefix;
+display MAGENTA . "CountDB:\t\t" . RESET . $countdb;
+
+display CYAN . "\nGlobal Clearcase Configuration\n" . RESET;
+
+display MAGENTA . "Client:\t\t\t" . RESET . $Clearcase::CC->client;
+display MAGENTA . "Hardware type:\t\t" . RESET . $Clearcase::CC->hardware_type;
+display MAGENTA . "License host:\t\t" . RESET . $Clearcase::CC->license_host;
+display MAGENTA . "OS:\t\t\t" . RESET . $Clearcase::CC->os;
+display MAGENTA . "Region:\t\t\t" . RESET . $Clearcase::CC->region;
+display MAGENTA . "Registry host:\t\t" . RESET . $Clearcase::CC->registry_host;
+display MAGENTA . "Sitename:\t\t" . RESET . $Clearcase::CC->sitename;
+display MAGENTA . "Version:\t\t" . RESET . $Clearcase::CC->version;
+
+display GREEN . "\nCleartool Access\n" . RESET;
+
+display_nolf MAGENTA . "Views:\t" . RESET;
+
+($status, @output) = $Clearcase::CC->execute ("lsview -s");
+
+display scalar @output;
+
+display_nolf MAGENTA . "VOBs:\t" . RESET;
+
+($status, @output) = $Clearcase::CC->execute ("lsvob -s");
+
+display scalar @output;
-#!/usr/bin/perl
+#!/usr/bin/env cqperl
use strict;
use warnings;
-#!/usr/bin/env /opt/rational/clearquest/bin/cqperl\r
-##############################################################################\r
-#\r
-# Name: cqtool\r
-#\r
-# Description: cqtool is an interface to Clearquest to perform some simple\r
-# actions to the RANCQ database. It is used primarily by ucmwb\r
-# but it also supports a command line interface.\r
-#\r
-# The following commands are supported:\r
-#\r
-# activate <wor> <project> <est_hours> <startdate> <enddate>:\r
-# Activate WOR\r
-# assign <wor> <assignee> <project> <planned_hours> <startdate>:\r
-# Assign the WOR\r
-# clone <wor>:\r
-# Clones a WOR\r
-# comment <wor> <comment>\r
-# Add a comment to the Notes_Entry field for the WOR\r
-# complete <wor> <actual_hours>:\r
-# Complete WOR\r
-# createhd:\r
-# Create a new Help Desk Ticket\r
-# createwor:\r
-# Create a new WOR\r
-# effort <wor> <hours>:\r
-# Update the WOR's actual hours\r
-# exit|quit:\r
-# Exits cqtool\r
-# help:\r
-# This display\r
-# link <parent wor> <child wor>:\r
-# Link a parent WOR to a child WOR\r
-# resolve <wor>:\r
-# Resolve WOR\r
-# set <wor> <field> <value>\r
-# Set <field> to <value> for the <wor>\r
-# usage:\r
-# Displays command line usage\r
-# version:\r
-# Displays version of cqtool\r
-#\r
-# Many of these commands simply perform actions on a wor. Two\r
-# of these commands, createwor and createhd have Perl/Tk GUI\r
-# interfaces.\r
-#\r
-# Command line usage:\r
-#\r
-# Usage: cqtool\t[-usage|help] [-verbose] [-debug]\r
-# [-userid <user>] [-password <password>] [<command>]\r
-#\r
-# Where:\r
-#\r
-# -usage|help: Display usage\r
-# -verbose: Turn on verbose mode\r
-# -debug: Turn on debug mode\r
-# -userid: User ID to log into Clearquest database as\r
-# -password: Password to use\r
-# <command> If specified then cqtool executes <command> and\r
-# exits\r
-#\r
-# Environment: cqtool supports the following environment variables\r
-# that are used mostly for tesing purposes\r
-#\r
-# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing -\r
-# default RANCQ) \r
-# CQ_USER: User name to log into the $CQ_DBSET database with\r
-# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with.\r
-#\r
-# Author: Andrew@DeFaria.com\r
-#\r
-# (c) Copyright 2007, General Dynamics, all rights reserved\r
-#\r
-##############################################################################\r
-use strict;\r
-use warnings;\r
-\r
-use CQPerlExt;\r
-use FindBin;\r
-use Getopt::Long;\r
-use Term::ANSIColor qw (:constants);\r
-\r
-use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");\r
-\r
-use SCCM::Misc;\r
-use Display;\r
-use CQTool;\r
-use CreateWORUI;\r
-use CreateHelpDeskUI;\r
-use Logger;\r
-\r
-my $VERSION = BOLD GREEN . "1.1" . RESET;\r
-my $PROMPT = BOLD YELLOW . ">>" . RESET;\r
-my $UCMWB_PROMPT = ">>";\r
-my $DESC = BOLD RED . "$FindBin::Script" .\r
- RESET " Version " .\r
- $VERSION .\r
- CYAN ": Program to talk to Clearquest" .\r
- RESET;\r
-\r
-# Globals\r
-my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER};\r
-my $_password = $ENV{CQ_PASSWORD};\r
-my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ";\r
-my $_ucmwb;\r
-\r
-my $_log;\r
-\r
-if (get_debug) {\r
- $_log = new Logger (\r
- path => "/tmp",\r
- append => 1,\r
- );\r
-} # if\r
-\r
-my %_commands = (\r
- activate => \&activate,\r
- assign => \&assign,\r
- clone => \&clone,\r
- comment => \&comment,\r
- complete => \&complete,\r
- createhd => \&createHelpDesk,\r
- createwor => \&createWOR,\r
- effort => \&effort,\r
- exit => \&shutdown,\r
- help => \&help,\r
- link => \&linkParentWor2ChildWor,\r
- quit => \&shutdown,\r
- resolve => \&resolve,\r
- set => \&set,\r
- usage => \&usage,\r
- version => \&announce,\r
-);\r
-\r
-##############################################################################\r
-# Forwards\r
-##############################################################################\r
-sub commandLoop (@);\r
-\r
-##############################################################################\r
-# Main\r
-##############################################################################\r
-MAIN: {\r
- GetOptions (\r
- "usage" => sub { usage () },\r
- "verbose" => sub { set_verbose () },\r
- "debug" => sub { set_debug () },\r
- "userid=s" => \$_userid,\r
- "password=s" => \$_password,\r
- "database=s" => \$_db_name,\r
- "ucmwb" => \$_ucmwb,\r
- ) || usage ();\r
-\r
- exit (commandLoop(@ARGV));\r
-} # MAIN\r
-\r
-##############################################################################\r
-# Subroutines\r
-##############################################################################\r
-\r
-#-----------------------------------------------------------------------------\r
-# shutdown (): Ends program\r
-#-----------------------------------------------------------------------------\r
-sub shutdown () {\r
- exit (0);\r
-} # exit\r
-\r
-#-----------------------------------------------------------------------------\r
-# help (): Displays help\r
-#-----------------------------------------------------------------------------\r
-sub help () {\r
- display ($DESC);\r
- display <<END;\r
-\r
-Valid commands are:\r
-\r
-activate <wor> <project> <est_hours> <startdate> <enddate>:\r
- Activate WOR\r
-assign <wor> <assignee> <project> <planned_hours> <startdate>:\r
- Assign the WOR\r
-clone <wor>:\r
- Clones a WOR\r
-comment <wor> <comment>\r
- Add a comment to the Notes_Entry field for the WOR\r
-complete <wor> <actual_hours>:\r
- Complete WOR\r
-createhd:\r
- Create a new Help Desk Ticket\r
-createwor:\r
- Create a new WOR\r
-effort <wor> <hours>:\r
- Update the WOR's actual hours\r
-exit|quit:\r
- Exits $FindBin::Script\r
-help:\r
- This display\r
-link <parent wor> <child wor>:\r
- Link a parent WOR to a child WOR\r
-resolve <wor>:\r
- Resolve WOR\r
-set <wor> <field> <value>\r
- Set <field> to <value> for the <wor>\r
-usage:\r
- Displays command line usage\r
-version:\r
- Displays version of $FindBin::Script\r
-END\r
-} # help\r
-\r
-#-----------------------------------------------------------------------------\r
-# announce (): Announce ourselves\r
-#-----------------------------------------------------------------------------\r
-sub announce () {\r
- display ($DESC);\r
-} # Announce\r
-\r
-#-----------------------------------------------------------------------------\r
-# dberror ($): Handle errors when talking to Clearquest. Note we need to reset\r
-# the database connection if an error happens.\r
-#-----------------------------------------------------------------------------\r
-sub dberror ($) {\r
- my ($msg) = @_;\r
-\r
- # Need to not only report the error but to reopen the\r
- # database. Something gets corruppted if we don't!\r
- error ($msg);\r
-\r
- closeDB ();\r
-\r
- openDB ($_userid, $_password, $_db_name);\r
-} # DBError\r
-\r
-#-----------------------------------------------------------------------------\r
-# getEntity ($$): Get an entity from Clearquest\r
-#-----------------------------------------------------------------------------\r
-sub getEntity ($$) {\r
- my ($recordname, $wor) = @_;\r
-\r
- my $entity;\r
-\r
- eval {\r
- $entity = $CQTool::session->GetEntity ($recordname, $wor);\r
- };\r
-\r
- if ($@) {\r
- chomp $@;\r
- dberror ($@);\r
- return undef;\r
- } else {\r
- return $entity;\r
- } # if\r
-} # getEntity\r
-\r
-#-----------------------------------------------------------------------------\r
-# set ($$$): Set $field to $value for $wor\r
-#-----------------------------------------------------------------------------\r
-sub set ($$@) {\r
- my ($wor, $field, $value) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$field or $field eq "") {\r
- error ("Field is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- $session->EditEntity ($entity, "modify");\r
-\r
- $_log->msg ("Modifying $field to \"$value\"") if get_debug;\r
- eval {\r
- $entity->SetFieldValue ($field, $value);\r
- };\r
-\r
- if ($@) {\r
- dberror ("$field set failed for WOR $wor:\n$@");\r
- return 2;\r
- } # if\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("$field validate failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("$field update failed during Submit for $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # set\r
-\r
-#-----------------------------------------------------------------------------\r
-# clone ($): Clone a WOR\r
-#-----------------------------------------------------------------------------\r
-sub clone ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor) {\r
- error ("WOR not specified!");\r
- return 1;\r
- } # if\r
-\r
- $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- # Check state\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Closed") {\r
- error ("WOR $wor not closed - Unable to clone!");\r
- return 1;\r
- } # if\r
-\r
- verbose ("Cloning WOR $wor...");\r
-\r
- my $result = 0;\r
-\r
- eval {\r
- # Currently Clone doesn't return a proper result but eventually...\r
- $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");\r
- };\r
-\r
- if ($@) {\r
- chomp $@;\r
- dberror ($@);\r
- return 1;\r
- } # if\r
-\r
- return $result;\r
-} # clone\r
-\r
-#-----------------------------------------------------------------------------\r
-# effort ($$): Update actual hours for a WOR\r
-#-----------------------------------------------------------------------------\r
-sub effort ($$) {\r
- my ($wor, $actualHrs) = @_;\r
-\r
- return set $wor, "ActualEffort", $actualHrs;\r
-} # effort\r
-\r
-#-----------------------------------------------------------------------------\r
-# comment (): Update the Notes_Entry comment field for a WOR\r
-#-----------------------------------------------------------------------------\r
-sub comment ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor) {\r
- error "WOR not defined in call to comment!";\r
- return 1;\r
- } # if\r
-\r
- if (!$_ucmwb) {\r
- display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");\r
- } else {\r
- # We still need to prompt for the comments however signal UCMWB\r
- # that command is ready for more input.\r
- display_nolf ($UCMWB_PROMPT);\r
- } # if\r
-\r
- my $comments;\r
-\r
- while (<STDIN>) {\r
- last if $_ eq ".\n";\r
- $comments .= $_;\r
- } # while\r
-\r
- chomp $comments;\r
-\r
- $_log->msg ("Comments:\n$comments") if get_debug;\r
-\r
- return set $wor, "Note_Entry", $comments;\r
-} # Comment\r
-\r
-#-----------------------------------------------------------------------------\r
-# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR\r
-#-----------------------------------------------------------------------------\r
-sub linkParentWor2ChildWor ($$) {\r
- my ($parentWor, $childWor) = @_;\r
-\r
- my $status;\r
-\r
- verbose ("Linking $parentWor -> $childWor...");\r
-\r
- my $childentity = getEntity ("WOR", $childWor);\r
- my $parententity = getEntity ("WOR", $parentWor);\r
-\r
- return 1 unless $childentity and $parententity;\r
-\r
- $session->EditEntity ($parententity, "modify");\r
-\r
- $parententity->AddFieldValue ("wor_children", $childWor);\r
-\r
- $status = $parententity->Validate ();\r
-\r
- if ($status ne "") {\r
- $parententity->Revert ();\r
- error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");\r
- return 1;\r
- } # if\r
-\r
- eval {\r
- $status = $parententity->Commit ();\r
- };\r
-\r
- $status = $@ if $@;\r
-\r
- if ($status ne "") {\r
- (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- debug "Modifying child $childWor...";\r
- $session->EditEntity ($childentity, "modify");\r
-\r
- $childentity->SetFieldValue ("wor_parent", $parentWor);\r
-\r
- $status = $childentity->Validate ();\r
-\r
- if ($status ne "") {\r
- $childentity->Revert ();\r
- error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";\r
- return 1;\r
- } # if\r
-\r
- eval {\r
- $status = $childentity->Commit ();\r
- };\r
-\r
- $status = $@ if $@;\r
-\r
- if ($status ne "") {\r
- error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # linkParentWor2ChildWor\r
-\r
-#-----------------------------------------------------------------------------\r
-# assign ($$$$): Assign a WOR\r
-#-----------------------------------------------------------------------------\r
-sub assign ($$$$$) {\r
- my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$assignee or $assignee eq "") {\r
- error ("Assignee must be specified");\r
- return 1;\r
- } # if\r
-\r
- if (!$project or $project eq "") {\r
- error ("UCM Project is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$startDate or $startDate eq "") {\r
- error ("Planned Start Date is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Submitted") {\r
- error ("WOR $wor is not in Submitted state!\nState: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "assign");\r
-\r
- $entity->SetFieldValue ("ucm_project", $project) if $project ne "";\r
- $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";\r
- $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne "";\r
- $entity->SetFieldValue ("Owner", $assignee) if $assignee ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Assign failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Assign failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # assign\r
-\r
-#-----------------------------------------------------------------------------\r
-# activate (): Activate a WOR\r
-#-----------------------------------------------------------------------------\r
-sub activate ($$$$$) {\r
- my ($wor, $project, $estHrs, $startDate, $endDate) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$project or $project eq "") {\r
- error ("UCM Project is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$startDate or $startDate eq "") {\r
- error ("Planned Start Date is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$endDate or $endDate eq "") {\r
- error ("Planned End Date is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Assessing") {\r
- error ("WOR $wor is not in Assessing state!\nstate: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "activate");\r
-\r
- $entity->SetFieldValue ("ucm_project", $project) if $project ne "";\r
- $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne "";\r
- $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";\r
- $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Activate failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Activate failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # activate\r
-\r
-#-----------------------------------------------------------------------------\r
-# resolve ($): Resolve a WOR\r
-#-----------------------------------------------------------------------------\r
-sub resolve ($) {\r
- my ($wor) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Working") {\r
- error ("WOR $wor is not in Working state!\nState: $state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "resolve");\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Resolve failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Resolve failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # resolve\r
-\r
-#-----------------------------------------------------------------------------\r
-# complete ($$): Complete a WOR\r
-#-----------------------------------------------------------------------------\r
-sub complete ($$) {\r
- my ($wor, $actualHrs) = @_;\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("WOR is required");\r
- return 1;\r
- } # if\r
-\r
- if (!$wor or $wor eq "") {\r
- error ("Actual Hours are required");\r
- return 1;\r
- } # if\r
-\r
- my $entity = getEntity ("WOR", $wor);\r
-\r
- return 1 if !$entity;\r
-\r
- my $state = $entity->GetFieldValue ("state")->GetValue ();\r
-\r
- if ($state ne "Verifying") {\r
- error ("WOR $wor is not in Verifying state!\nState:$state");\r
- return 2;\r
- } # if\r
-\r
- $session->EditEntity ($entity, "complete");\r
- $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";\r
-\r
- my $status = $entity->Validate ();\r
-\r
- if ($status ne "") {\r
- $entity->Revert ();\r
- error ("Complete failed for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- $status = $entity->Commit ();\r
-\r
- if ($status ne "") {\r
- error ("Complete failed during Submit for WOR $wor:\n$status");\r
- return 2;\r
- } # if\r
-\r
- return 0;\r
-} # Complete\r
-\r
-#-----------------------------------------------------------------------------\r
-# executeCommand (@): Executes a cqtool command\r
-#-----------------------------------------------------------------------------\r
-sub executeCommand (@) {\r
- my (@args) = @_;\r
-\r
- my $cmd = lc shift @args;\r
-\r
- return if $cmd eq "";\r
-\r
- if ($_commands{$cmd}) {\r
- if (!$CQTool::session) {\r
- if ( # Commands that do not require a database connection\r
- !($cmd eq "exit" or\r
- $cmd eq "quit" or\r
- $cmd eq "help" or\r
- $cmd eq "usage" or\r
- $cmd eq "verbose")) {\r
- verbose "Opening $_db_name as $_userid...";\r
-\r
- if (!$_password) {\r
- display_nolf ("${_userid}'s password:");\r
- `stty -echo`;\r
- $_password = <STDIN>;\r
- chomp $_password;\r
- display ("");\r
- `stty echo`;\r
- } # if\r
-\r
- openDB ($_userid, $_password, $_db_name);\r
- } # if\r
- } # if\r
-\r
- # Treat args: Args that are enclosed in quotes must be\r
- # combined. For simplicity's sake we will only support matched\r
- # pairs of double quotes. Anything else results in undefined\r
- # behavior.\r
- my (@new_args);\r
-\r
- foreach (@args) {\r
- # Quoted argument starting\r
- if (/^\"(.*)\"$/s) {\r
- push @new_args, $1;\r
- } else {\r
- push @new_args, $_;\r
- } # if\r
- } # foreach\r
-\r
- $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;\r
-\r
- return $_commands{$cmd} (@new_args);\r
- } else {\r
- error ("Unknown command \"$cmd\" (try help)");\r
- return 1;\r
- } # if\r
-} # executeCommand\r
-\r
-#-----------------------------------------------------------------------------\r
-# commandLoop (@): This is the interactive command loop\r
-#-----------------------------------------------------------------------------\r
-sub commandLoop (@) {\r
- my (@args) = @_;\r
-\r
- # For single, command line, commands...\r
- return executeCommand (@args) if @args;\r
-\r
- announce if !$_ucmwb;\r
-\r
- while () {\r
- if (!$_ucmwb) {\r
- display_nolf ($PROMPT . RESET . UNDERLINE);\r
- } else {\r
- display_nolf ($UCMWB_PROMPT);\r
- } # if\r
-\r
- # Read command into $_\r
- $_ = <STDIN>;\r
- chomp;\r
-\r
- # If we are not being called by ucmwb, display RESET to stop the\r
- # UNDERLINE we were using. This keeps the output from being\r
- # underlined. In ucmwb mode we are not using any of the terminal\r
- # sequences.\r
- display_nolf (RESET) if !$_ucmwb;\r
-\r
- # If the user hit Control-d then a ^D is displayed but we remain\r
- # on the same line. So output a carriage return and exit 0.\r
- if (!$_) {\r
- display ("");\r
- exit 0;\r
- } # if\r
-\r
- # Special handling for set command since we want to take\r
- # everything after <field> to be a value, and we may get long\r
- # values that are space separated and space significant\r
- # (e.g. description?)\r
- if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) {\r
- if (lc $1 eq "set") {\r
- my $cmd = $1;\r
- my $wor = $2;\r
- my $field = $3;\r
- my $value = $4;\r
-\r
- # Change "\n"'s back to \n's\r
- $value =~ s/\\n/\n/g;\r
-\r
- executeCommand ($cmd, $wor, $field, "\"$value\"");\r
- } else {\r
- executeCommand (split);\r
- } # if\r
- } else {\r
- executeCommand (split);\r
- } # if\r
- } # while\r
-} # commandLoop\r
+#!/usr/bin/env /opt/rational/clearquest/bin/cqperl
+##############################################################################
+#
+# Name: cqtool
+#
+# Description: cqtool is an interface to Clearquest to perform some simple
+# actions to the RANCQ database. It is used primarily by ucmwb
+# but it also supports a command line interface.
+#
+# The following commands are supported:
+#
+# activate <wor> <project> <est_hours> <startdate> <enddate>:
+# Activate WOR
+# assign <wor> <assignee> <project> <planned_hours> <startdate>:
+# Assign the WOR
+# clone <wor>:
+# Clones a WOR
+# comment <wor> <comment>
+# Add a comment to the Notes_Entry field for the WOR
+# complete <wor> <actual_hours>:
+# Complete WOR
+# createhd:
+# Create a new Help Desk Ticket
+# createwor:
+# Create a new WOR
+# effort <wor> <hours>:
+# Update the WOR's actual hours
+# exit|quit:
+# Exits cqtool
+# help:
+# This display
+# link <parent wor> <child wor>:
+# Link a parent WOR to a child WOR
+# resolve <wor>:
+# Resolve WOR
+# set <wor> <field> <value>
+# Set <field> to <value> for the <wor>
+# usage:
+# Displays command line usage
+# version:
+# Displays version of cqtool
+#
+# Many of these commands simply perform actions on a wor. Two
+# of these commands, createwor and createhd have Perl/Tk GUI
+# interfaces.
+#
+# Command line usage:
+#
+# Usage: cqtool\t[-usage|help] [-verbose] [-debug]
+# [-userid <user>] [-password <password>] [<command>]
+#
+# Where:
+#
+# -usage|help: Display usage
+# -verbose: Turn on verbose mode
+# -debug: Turn on debug mode
+# -userid: User ID to log into Clearquest database as
+# -password: Password to use
+# <command> If specified then cqtool executes <command> and
+# exits
+#
+# Environment: cqtool supports the following environment variables
+# that are used mostly for tesing purposes
+#
+# CQ_DBSET: Clearquest DBSET to open (e.g. XTST3 for testing -
+# default RANCQ)
+# CQ_USER: User name to log into the $CQ_DBSET database with
+# CQ_PASSWORD: Password to use to log into the $CQ_DBSET with.
+#
+# Author: Andrew@DeFaria.com
+#
+# (c) Copyright 2007, General Dynamics, all rights reserved
+#
+##############################################################################
+use strict;
+use warnings;
+
+use CQPerlExt;
+use FindBin;
+use Getopt::Long;
+use Term::ANSIColor qw (:constants);
+
+use lib ("$FindBin::Bin", "$FindBin::Bin/../lib");
+
+use SCCM::Misc;
+use Display;
+use CQTool;
+use CreateWORUI;
+use CreateHelpDeskUI;
+use Logger;
+
+my $VERSION = BOLD GREEN . "1.1" . RESET;
+my $PROMPT = BOLD YELLOW . ">>" . RESET;
+my $UCMWB_PROMPT = ">>";
+my $DESC = BOLD RED . "$FindBin::Script" .
+ RESET " Version " .
+ $VERSION .
+ CYAN ": Program to talk to Clearquest" .
+ RESET;
+
+# Globals
+my $_userid = $ENV{CQ_USER} ? $ENV{CQ_USER} : $ENV{USER};
+my $_password = $ENV{CQ_PASSWORD};
+my $_db_name = $ENV{CQ_DBSET} ? $ENV{CQ_DBSET} : "RANCQ";
+my $_ucmwb;
+
+my $_log;
+
+if (get_debug) {
+ $_log = new Logger (
+ path => "/tmp",
+ append => 1,
+ );
+} # if
+
+my %_commands = (
+ activate => \&activate,
+ assign => \&assign,
+ clone => \&clone,
+ comment => \&comment,
+ complete => \&complete,
+ createhd => \&createHelpDesk,
+ createwor => \&createWOR,
+ effort => \&effort,
+ exit => \&shutdown,
+ help => \&help,
+ link => \&linkParentWor2ChildWor,
+ quit => \&shutdown,
+ resolve => \&resolve,
+ set => \&set,
+ usage => \&usage,
+ version => \&announce,
+);
+
+##############################################################################
+# Forwards
+##############################################################################
+sub commandLoop (@);
+
+##############################################################################
+# Main
+##############################################################################
+MAIN: {
+ GetOptions (
+ "usage" => sub { usage () },
+ "verbose" => sub { set_verbose () },
+ "debug" => sub { set_debug () },
+ "userid=s" => \$_userid,
+ "password=s" => \$_password,
+ "database=s" => \$_db_name,
+ "ucmwb" => \$_ucmwb,
+ ) || usage ();
+
+ exit (commandLoop(@ARGV));
+} # MAIN
+
+##############################################################################
+# Subroutines
+##############################################################################
+
+#-----------------------------------------------------------------------------
+# shutdown (): Ends program
+#-----------------------------------------------------------------------------
+sub shutdown () {
+ exit (0);
+} # exit
+
+#-----------------------------------------------------------------------------
+# help (): Displays help
+#-----------------------------------------------------------------------------
+sub help () {
+ display ($DESC);
+ display <<END;
+
+Valid commands are:
+
+activate <wor> <project> <est_hours> <startdate> <enddate>:
+ Activate WOR
+assign <wor> <assignee> <project> <planned_hours> <startdate>:
+ Assign the WOR
+clone <wor>:
+ Clones a WOR
+comment <wor> <comment>
+ Add a comment to the Notes_Entry field for the WOR
+complete <wor> <actual_hours>:
+ Complete WOR
+createhd:
+ Create a new Help Desk Ticket
+createwor:
+ Create a new WOR
+effort <wor> <hours>:
+ Update the WOR's actual hours
+exit|quit:
+ Exits $FindBin::Script
+help:
+ This display
+link <parent wor> <child wor>:
+ Link a parent WOR to a child WOR
+resolve <wor>:
+ Resolve WOR
+set <wor> <field> <value>
+ Set <field> to <value> for the <wor>
+usage:
+ Displays command line usage
+version:
+ Displays version of $FindBin::Script
+END
+} # help
+
+#-----------------------------------------------------------------------------
+# announce (): Announce ourselves
+#-----------------------------------------------------------------------------
+sub announce () {
+ display ($DESC);
+} # Announce
+
+#-----------------------------------------------------------------------------
+# dberror ($): Handle errors when talking to Clearquest. Note we need to reset
+# the database connection if an error happens.
+#-----------------------------------------------------------------------------
+sub dberror ($) {
+ my ($msg) = @_;
+
+ # Need to not only report the error but to reopen the
+ # database. Something gets corruppted if we don't!
+ error ($msg);
+
+ closeDB ();
+
+ openDB ($_userid, $_password, $_db_name);
+} # DBError
+
+#-----------------------------------------------------------------------------
+# getEntity ($$): Get an entity from Clearquest
+#-----------------------------------------------------------------------------
+sub getEntity ($$) {
+ my ($recordname, $wor) = @_;
+
+ my $entity;
+
+ eval {
+ $entity = $CQTool::session->GetEntity ($recordname, $wor);
+ };
+
+ if ($@) {
+ chomp $@;
+ dberror ($@);
+ return undef;
+ } else {
+ return $entity;
+ } # if
+} # getEntity
+
+#-----------------------------------------------------------------------------
+# set ($$$): Set $field to $value for $wor
+#-----------------------------------------------------------------------------
+sub set ($$@) {
+ my ($wor, $field, $value) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$field or $field eq "") {
+ error ("Field is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ $session->EditEntity ($entity, "modify");
+
+ $_log->msg ("Modifying $field to \"$value\"") if get_debug;
+ eval {
+ $entity->SetFieldValue ($field, $value);
+ };
+
+ if ($@) {
+ dberror ("$field set failed for WOR $wor:\n$@");
+ return 2;
+ } # if
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("$field validate failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("$field update failed during Submit for $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # set
+
+#-----------------------------------------------------------------------------
+# clone ($): Clone a WOR
+#-----------------------------------------------------------------------------
+sub clone ($) {
+ my ($wor) = @_;
+
+ if (!$wor) {
+ error ("WOR not specified!");
+ return 1;
+ } # if
+
+ $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ # Check state
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Closed") {
+ error ("WOR $wor not closed - Unable to clone!");
+ return 1;
+ } # if
+
+ verbose ("Cloning WOR $wor...");
+
+ my $result = 0;
+
+ eval {
+ # Currently Clone doesn't return a proper result but eventually...
+ $result = $CQTool::session->FireRecordScriptAlias ($entity, "Clone");
+ };
+
+ if ($@) {
+ chomp $@;
+ dberror ($@);
+ return 1;
+ } # if
+
+ return $result;
+} # clone
+
+#-----------------------------------------------------------------------------
+# effort ($$): Update actual hours for a WOR
+#-----------------------------------------------------------------------------
+sub effort ($$) {
+ my ($wor, $actualHrs) = @_;
+
+ return set $wor, "ActualEffort", $actualHrs;
+} # effort
+
+#-----------------------------------------------------------------------------
+# comment (): Update the Notes_Entry comment field for a WOR
+#-----------------------------------------------------------------------------
+sub comment ($) {
+ my ($wor) = @_;
+
+ if (!$wor) {
+ error "WOR not defined in call to comment!";
+ return 1;
+ } # if
+
+ if (!$_ucmwb) {
+ display ("Enter comments below. When finished, enter \".\" on a line by itself or hit ^D:");
+ } else {
+ # We still need to prompt for the comments however signal UCMWB
+ # that command is ready for more input.
+ display_nolf ($UCMWB_PROMPT);
+ } # if
+
+ my $comments;
+
+ while (<STDIN>) {
+ last if $_ eq ".\n";
+ $comments .= $_;
+ } # while
+
+ chomp $comments;
+
+ $_log->msg ("Comments:\n$comments") if get_debug;
+
+ return set $wor, "Note_Entry", $comments;
+} # Comment
+
+#-----------------------------------------------------------------------------
+# linkParentWor2ChildWor ($$): Link a child WOR to a parent WOR
+#-----------------------------------------------------------------------------
+sub linkParentWor2ChildWor ($$) {
+ my ($parentWor, $childWor) = @_;
+
+ my $status;
+
+ verbose ("Linking $parentWor -> $childWor...");
+
+ my $childentity = getEntity ("WOR", $childWor);
+ my $parententity = getEntity ("WOR", $parentWor);
+
+ return 1 unless $childentity and $parententity;
+
+ $session->EditEntity ($parententity, "modify");
+
+ $parententity->AddFieldValue ("wor_children", $childWor);
+
+ $status = $parententity->Validate ();
+
+ if ($status ne "") {
+ $parententity->Revert ();
+ error ("Validation failed while attempting to add child WOR $childWor to parent WOR $parentWor:\n$status");
+ return 1;
+ } # if
+
+ eval {
+ $status = $parententity->Commit ();
+ };
+
+ $status = $@ if $@;
+
+ if ($status ne "") {
+ (error "Commit failed while trying to add child WOR $childWor to parent WOR $parentWor:\n$status");
+ return 2;
+ } # if
+
+ debug "Modifying child $childWor...";
+ $session->EditEntity ($childentity, "modify");
+
+ $childentity->SetFieldValue ("wor_parent", $parentWor);
+
+ $status = $childentity->Validate ();
+
+ if ($status ne "") {
+ $childentity->Revert ();
+ error "Validation failed while attempting to add parent WOR $parentWor to child WOR $childWor:\n$status";
+ return 1;
+ } # if
+
+ eval {
+ $status = $childentity->Commit ();
+ };
+
+ $status = $@ if $@;
+
+ if ($status ne "") {
+ error "Commit failed while trying to add parent WOR $parentWor to child WOR $childWor:\n$status";
+ return 2;
+ } # if
+
+ return 0;
+} # linkParentWor2ChildWor
+
+#-----------------------------------------------------------------------------
+# assign ($$$$): Assign a WOR
+#-----------------------------------------------------------------------------
+sub assign ($$$$$) {
+ my ($wor, $assignee, $project, $plannedHrs, $startDate) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$assignee or $assignee eq "") {
+ error ("Assignee must be specified");
+ return 1;
+ } # if
+
+ if (!$project or $project eq "") {
+ error ("UCM Project is required");
+ return 1;
+ } # if
+
+ if (!$startDate or $startDate eq "") {
+ error ("Planned Start Date is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Submitted") {
+ error ("WOR $wor is not in Submitted state!\nState: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "assign");
+
+ $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
+ $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
+ $entity->SetFieldValue ("PlannedEffort", $plannedHrs) if $plannedHrs ne "";
+ $entity->SetFieldValue ("Owner", $assignee) if $assignee ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Assign failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Assign failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # assign
+
+#-----------------------------------------------------------------------------
+# activate (): Activate a WOR
+#-----------------------------------------------------------------------------
+sub activate ($$$$$) {
+ my ($wor, $project, $estHrs, $startDate, $endDate) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$project or $project eq "") {
+ error ("UCM Project is required");
+ return 1;
+ } # if
+
+ if (!$startDate or $startDate eq "") {
+ error ("Planned Start Date is required");
+ return 1;
+ } # if
+
+ if (!$endDate or $endDate eq "") {
+ error ("Planned End Date is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Assessing") {
+ error ("WOR $wor is not in Assessing state!\nstate: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "activate");
+
+ $entity->SetFieldValue ("ucm_project", $project) if $project ne "";
+ $entity->SetFieldValue ("EstimatedEffort", $estHrs) if $estHrs ne "";
+ $entity->SetFieldValue ("PlannedStart", $startDate) if $startDate ne "";
+ $entity->SetFieldValue ("PlannedEnd", $endDate) if $endDate ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Activate failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Activate failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # activate
+
+#-----------------------------------------------------------------------------
+# resolve ($): Resolve a WOR
+#-----------------------------------------------------------------------------
+sub resolve ($) {
+ my ($wor) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Working") {
+ error ("WOR $wor is not in Working state!\nState: $state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "resolve");
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Resolve failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Resolve failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # resolve
+
+#-----------------------------------------------------------------------------
+# complete ($$): Complete a WOR
+#-----------------------------------------------------------------------------
+sub complete ($$) {
+ my ($wor, $actualHrs) = @_;
+
+ if (!$wor or $wor eq "") {
+ error ("WOR is required");
+ return 1;
+ } # if
+
+ if (!$wor or $wor eq "") {
+ error ("Actual Hours are required");
+ return 1;
+ } # if
+
+ my $entity = getEntity ("WOR", $wor);
+
+ return 1 if !$entity;
+
+ my $state = $entity->GetFieldValue ("state")->GetValue ();
+
+ if ($state ne "Verifying") {
+ error ("WOR $wor is not in Verifying state!\nState:$state");
+ return 2;
+ } # if
+
+ $session->EditEntity ($entity, "complete");
+ $entity->SetFieldValue ("ActualEffort", $actualHrs) if $actualHrs ne "";
+
+ my $status = $entity->Validate ();
+
+ if ($status ne "") {
+ $entity->Revert ();
+ error ("Complete failed for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ $status = $entity->Commit ();
+
+ if ($status ne "") {
+ error ("Complete failed during Submit for WOR $wor:\n$status");
+ return 2;
+ } # if
+
+ return 0;
+} # Complete
+
+#-----------------------------------------------------------------------------
+# executeCommand (@): Executes a cqtool command
+#-----------------------------------------------------------------------------
+sub executeCommand (@) {
+ my (@args) = @_;
+
+ my $cmd = lc shift @args;
+
+ return if $cmd eq "";
+
+ if ($_commands{$cmd}) {
+ if (!$CQTool::session) {
+ if ( # Commands that do not require a database connection
+ !($cmd eq "exit" or
+ $cmd eq "quit" or
+ $cmd eq "help" or
+ $cmd eq "usage" or
+ $cmd eq "verbose")) {
+ verbose "Opening $_db_name as $_userid...";
+
+ if (!$_password) {
+ display_nolf ("${_userid}'s password:");
+ `stty -echo`;
+ $_password = <STDIN>;
+ chomp $_password;
+ display ("");
+ `stty echo`;
+ } # if
+
+ openDB ($_userid, $_password, $_db_name);
+ } # if
+ } # if
+
+ # Treat args: Args that are enclosed in quotes must be
+ # combined. For simplicity's sake we will only support matched
+ # pairs of double quotes. Anything else results in undefined
+ # behavior.
+ my (@new_args);
+
+ foreach (@args) {
+ # Quoted argument starting
+ if (/^\"(.*)\"$/s) {
+ push @new_args, $1;
+ } else {
+ push @new_args, $_;
+ } # if
+ } # foreach
+
+ $_log->msg ("$cmd (" . join (",", @new_args) . ")") if get_debug;
+
+ return $_commands{$cmd} (@new_args);
+ } else {
+ error ("Unknown command \"$cmd\" (try help)");
+ return 1;
+ } # if
+} # executeCommand
+
+#-----------------------------------------------------------------------------
+# commandLoop (@): This is the interactive command loop
+#-----------------------------------------------------------------------------
+sub commandLoop (@) {
+ my (@args) = @_;
+
+ # For single, command line, commands...
+ return executeCommand (@args) if @args;
+
+ announce if !$_ucmwb;
+
+ while () {
+ if (!$_ucmwb) {
+ display_nolf ($PROMPT . RESET . UNDERLINE);
+ } else {
+ display_nolf ($UCMWB_PROMPT);
+ } # if
+
+ # Read command into $_
+ $_ = <STDIN>;
+ chomp;
+
+ # If we are not being called by ucmwb, display RESET to stop the
+ # UNDERLINE we were using. This keeps the output from being
+ # underlined. In ucmwb mode we are not using any of the terminal
+ # sequences.
+ display_nolf (RESET) if !$_ucmwb;
+
+ # If the user hit Control-d then a ^D is displayed but we remain
+ # on the same line. So output a carriage return and exit 0.
+ if (!$_) {
+ display ("");
+ exit 0;
+ } # if
+
+ # Special handling for set command since we want to take
+ # everything after <field> to be a value, and we may get long
+ # values that are space separated and space significant
+ # (e.g. description?)
+ if (/^\s*(\w+)\s+(\w+)\s+(\w+)\s+(.*)/) {
+ if (lc $1 eq "set") {
+ my $cmd = $1;
+ my $wor = $2;
+ my $field = $3;
+ my $value = $4;
+
+ # Change "\n"'s back to \n's
+ $value =~ s/\\n/\n/g;
+
+ executeCommand ($cmd, $wor, $field, "\"$value\"");
+ } else {
+ executeCommand (split);
+ } # if
+ } else {
+ executeCommand (split);
+ } # if
+ } # while
+} # commandLoop
--- /dev/null
+################################################################################
+#
+# File: machines
+# Description: Defintion of machines for allmach
+# Author: Andrew@DeFaria.com
+#
+################################################################################
+# Column 1 Machine name
+# Column 2 Model
+# Column 3 OS Version
+# Column 4 ClearCase Version (if applicable)
+# Column 5 Owner (if known)
+# Column 6 Usage (if known)
+cowboys:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob1/registry server
+patriots:Sun:?:Solaris 5.9:7.0.1.0:ccadm:ranvob2
+rams:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob3/registry server
+chargers:Sun:Solaris 5.9:70.1.1:ccadm:ranview1
+colts:Sun:Solaris 5.9:7.0.1.0:ccadm:ranview2
+ranbuild1:Sun:Solaris 5.8:7.0.1.0:ccadm:builds
+ranbuild2:Sun:Solaris 5.9:2003.06.10+:ccadm:builds
+ranbuild4:Sun:Solaris 5.9:7.0.1.1:ccadm:builds
+randws119:Sun:Solaris 5.9:7.0.1.1:Hy Truong:Workstation
+randws094:Sun:Solaris 5.10:7.0.1.1:John Hartin:Old workstation
+randws033:Sun:Solaris 5.10:Sam Schwalm:Workstation
+randws103:Sun:Solaris 5.9:7.0.1.1:?:?
+randws106:Sun:Solaris 5.9:2003.06.10+:?:?
+randws113:Sun:Solaris 5.9:7.0.1.1:?:?
+randws114:Sun:Solaris 5.9:2003.06.10+:Tony Trujilo:?
+randws000:Sun:Solaris 5.10:7.0.1.1:?:?
+randws021:?:?:?:?:?
+randws035:?:?:?:ccadm:?
+randws036:?:?:?:ccadm:?
+ranadm1:Sun:Solaris 5.9:?:ccadm:Jumpstart, PowerBroker, NIS, SMTP, DNS, NTP
+ranadm2:Sun:Solaris 5.9:2003.06.10+:ccadm:License server, Sys admin, NIS, Home Directory server
+ranray:Sun:Solaris 5.9:2003.06.10+:ccadm:?
+ranray16:?:?:?:ccadm:Thin client to ranray
+niners:Sun:Solaris 5.9:2003.06.10+:ccadm:?
+randbs:Sun:Solaris 5.9:?:ccadm:CQ DB server/Bldforge
+ranbkp2:?:?:?:ccadm:?
+ranlin03:Redhat Linux:2.4.21-50.Elsmp:?:ccadm:?
+rancpp10:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp01:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp02:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp03:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
--- /dev/null
+################################################################################
+#
+# File: machines
+# Description: Defintion of machines for allmach
+# Author: Andrew@DeFaria.com
+#
+################################################################################
+# Column 1 Machine name
+# Column 2 Model
+# Column 3 OS Version
+# Column 4 ClearCase Version (if applicable)
+# Column 5 Owner (if known)
+# Column 6 Usage (if known)
+chargers:Sun:Solaris 5.9:70.1.1:ccadm:ranview1
+colts:Sun:Solaris 5.9:7.0.1.0:ccadm:ranview2
+cowboys:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob1/registry server
+niners:Sun:Solaris 5.9:2003.06.10+:ccadm:?
+patriots:Sun:?:Solaris 5.9:7.0.1.0:ccadm:ranvob2
+rams:Sun:Solaris 5.9:7.0.1.0:ccadm:ranvob3/registry server
+#ranadm1:Sun:Solaris 5.9:?:ccadm:Jumpstart, PowerBroker, NIS, SMTP, DNS, NTP
+ranadm2:Sun:Solaris 5.9:2003.06.10+:ccadm:License server, Sys admin, NIS, Home Directory server
+ranbkp2:?:?:?:ccadm:?
+ranbuild1:Sun:Solaris 5.8:7.0.1.0:ccadm:builds
+ranbuild2:Sun:Solaris 5.9:2003.06.10+:ccadm:builds
+ranbuild4:Sun:Solaris 5.9:7.0.1.1:ccadm:builds
+rancpp01:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp02:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp03:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+rancpp10:Redhat Linux:2.6.18.53.Eel5xen:?:ccadm:?
+#randbs:Sun:Solaris 5.9:?:ccadm:CQ DB server/Bldforge
+randws094:Sun:Solaris 5.10:7.0.1.1:John Hartin:Old workstation
+randws103:Sun:Solaris 5.9:7.0.1.1:?:?
+randws106:Sun:Solaris 5.9:2003.06.10+:?:?
+randws113:Sun:Solaris 5.9:7.0.1.1:?:?
+randws114:Sun:Solaris 5.9:2003.06.10+:Tony Trujilo:?
+randws119:Sun:Solaris 5.9:7.0.1.1:Hy Truong:Workstation
+ranlin03:Redhat Linux:2.4.21-50.Elsmp:?:ccadm:?
+ranray:Sun:Solaris 5.9:2003.06.10+:ccadm:?
--- /dev/null
+################################################################################
+#
+# File: windows
+# Description: Defintion of machines for allmach
+# Author: Andrew@DeFaria.com
+#
+################################################################################
+# Column 1 Machine name
+# Column 2 Model
+# Column 3 OS Version
+# Column 4 ClearCase Version (if applicable)
+# Column 5 Owner (if known)
+# Column 6 Usage (if known)
+ranframe06:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe07:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe09:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker/Buildforge Console
+ranframe12:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe14:Microsoft:Windows Server 2003:7.0.1.7:ccadm:Frame Maker
+ranframe15:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe16:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe17:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe18:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe19:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
+ranframe20:Microsoft:Windows Server 2003:2003.06.10+:ccadm:Frame Maker
use OSDep;
use Display;
-my ($clearpid, $clearin, $clearout, $oldHandler);
+my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool);
-our $VIEW_DRIVE = 'M';
+our $VIEW_DRIVE = $ENV{CLEARCASE_VIEW_DRIVE} || 'M';
our $VOB_MOUNT = 'vob';
our $WIN_VOB_PREFIX = '\\';
our $SFX = $ENV{CLEARCASE_XN_SFX} ? $ENV{CLEARCASE_XN_SFX} : '@@';
-our $VOBTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin')
+our $VOBTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin')
? $WIN_VOB_PREFIX
- : "/$VOB_MOUNT/";
-our $VIEWTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin')
+ : "/$VOB_MOUNT";
+our $VIEWTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin')
? "$VIEW_DRIVE:"
: "${SEPARATOR}view";
BEGIN {
# Find executables that we rely on
- if ($ARCH eq 'windows' or $ARCH eq 'cygwin') {
+ if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') {
# Should really go to the registry for this...
# We can go to the registry pretty easy in Cygwin but I'm not sure how to do
# that in plain old Windows. Most people either have Clearcase installed on
# the C drive or commonly on the D drive on servers. So we'll look at both.
- $CCHOME = 'C:\\Program Files\\Rational\\Clearcase';
+ $CCHOME = 'C:\\Program Files (x86)\\ibm\\RationalSDLC\\Clearcase';
- $CCHOME = 'D:\\Program Files\\Rational\\Clearcase'
+ $CCHOME = 'D:\\Program Files (x86)\\ibm\\RationalSDLC\\Clearcase'
unless -d $CCHOME;
error 'Unable to figure out where Clearcase is installed', 1
sub _setComment ($) {
my ($comment) = @_;
- return !$comment ? '-nc' : '-c "' . quotameta $comment . '"';
+ return !$comment ? '-nc' : '-c "' . quotemeta $comment . '"';
} # _setComment
sub vobname ($) {
if (substr ($tag, 0, 1) eq '\\') {
$name = substr $tag, 1;
} elsif (substr ($tag, 0, 1) eq '/') {
- if ($tag =~ /${Clearcase::VOBTAG_PREFIX}(.+)/) {
+ if ($tag =~ /${Clearcase::VOBTAG_PREFIX}\/(.+)/) {
$name = $1;
} # if
} # if
# installed under /opt/rational/clearcase/bin. This is needed in case we wish
# to use these Clearcase objects say in a web page where the server is often
# run as a plain user who does not have cleartool in their path.
- my $cleartool;
-
- if ($ARCH =~ /Win/ or $ARCH eq 'cygwin') {
- $cleartool = 'cleartool';
- } elsif (-x '/opt/rational/clearcase/bin/cleartool') {
- $cleartool = '/opt/rational/clearcase/bin/cleartool';
- } # if
+ unless ($cleartool) {
+ if ($ARCHITECTURE =~ /Win/i or $ARCHITECTURE eq 'cygwin') {
+ $cleartool = 'cleartool';
+ } elsif (-x '/opt/rational/clearcase/bin/cleartool') {
+ $cleartool = '/opt/rational/clearcase/bin/cleartool';
+ } # if
+ } # unless
# TODO: Need to catch SIGCHILD here in case the user does something like hit
# Ctrl-C. Such an action may interrupt the underlying cleartool process and
pop @output
if @output and $output[$#output] eq '';
- $self->{status} = $status;
- $self->{output} = join "\n", @output;
+ $self->{lastcmd} = 'cleartool ' . $cmd;
+ $self->{status} = $status;
+ $self->{output} = join "\n", @output;
return ($status, @output);
} # execute
+sub lastcmd() {
+ my ($self) = @_;
+
+=pod
+
+=head2 lastcmd()
+
+Return last command attempted by execute
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Last command attempted by execute
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $self->{lastcmd} ||= '';
+
+ return $self->{lastcmd};
+} # lastcmd
+
sub new {
my ($class) = @_;
my @changeset = $activity->changeset;
- foreach my $element (@changeset) {
+ for my $element (@changeset) {
display "Element name: " . $element->pname;
display "Element verison: " . $element->version;
- } # foreach
+ } # for
=head1 DESCRIPTION
use strict;
use warnings;
-use lib '../..';
-
-use Clearcase;
-use Clearcase::Element;
-
# We should really inherit these from a more generic super class...
-sub _processOpts (%) {
+sub _processOpts(%) {
my ($self, %opts) = @_;
my $opts;
- foreach (keys %opts) {
+ for (keys %opts) {
if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') {
$opts .= "-$_ ";
} elsif ($_ eq 'c' or $_ eq 'cfile') {
$opts .= "-$_ $opts{$_}";
} # if
- } # foreach
+ } # for
return $opts;
} # _processOpts
-sub new ($$) {
+sub new($$) {
my ($class, $activity, $pvob) = @_;
=pod
=cut
- my $self = bless {
+ $class = bless {
name => $activity,
- pvob => Clearcase::vobtag ($pvob),
+ pvob => $pvob,
type => $activity =~ /^(deliver|rebase)./ ? 'integration' : 'regular',
}, $class; # bless
- return $self;
+ return $class;
} # new
-sub name () {
+sub name() {
my ($self) = @_;
=pod
return $self->{name};
} # name
-sub pvob () {
+sub pvob() {
my ($self) = @_;
=pod
return $self->{pvob};
} # pvob
-sub type () {
+sub type() {
my ($self) = @_;
=pod
return $self->{type};
} # type
-sub contrib_acts () {
+sub contrib_acts() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{contrib_acts};
+ $self->updateActivityInfo() unless $self->{contrib_acts};
return $self->{contrib_acts};
} # crm_record
-sub crm_record_id () {
+sub crm_record_id() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{crm_record_id};
+ $self->updateActivityInfo() unless $self->{crm_record_id};
return $self->{crm_record_id};
} # crm_record_id
-sub crm_record_type () {
+sub crm_record_type() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{crm_record_type};
+ $self->updateActivityInfo() unless $self->{crm_record_type};
return $self->{crm_record_type};
} # crm_record_type
-sub crm_state () {
+sub crm_state() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{crm_state};
+ $self->updateActivityInfo() unless $self->{crm_state};
return $self->{crm_state};
} # crm_state
-sub headline () {
+sub headline() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{headline};
+ $self->updateActivityInfo() unless $self->{headline};
return $self->{headline};
} # headline
-sub name_resolver_view () {
+sub name_resolver_view() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{name_resolver_view};
+ $self->updateActivityInfo() unless $self->{name_resolver_view};
return $self->{name_resolver_view};
} # name_resolver_view
-sub stream () {
+sub stream() {
my ($self) = @_;
=pod
=cut
- $self->updateActivityInfo () unless $self->{stream};
+ $self->updateActivityInfo() unless $self->{stream};
return $self->{stream};
} # stream
-sub changeset (;$) {
+sub changeset(;$) {
my ($self, $recalc) = @_;
=pod
my $cmd = "lsact -fmt \"%[versions]CQp\" $self->{name}\@$pvob";
- my ($status, @output) = $Clearcase::CC->execute ($cmd);
+ my ($status, @output) = $Clearcase::CC->execute($cmd);
return ($status, @output)
if $status;
@output = split /\", \"/, $output[0]
if $output[0];
- foreach (@output) {
+ for (@output) {
# Skip any cleartool warnings. We are getting warnings of the form:
# "A version in the change set of activity "63332.4" is currently
# unavailable". Probably some sort of subtle corruption that we can ignore.
# Additionally we will set into the $element object the extended name. This
# is the long pathname that we need to use from our current context to be
# able to access the element.
- #$element->setExtendedName ($_);
+ #$element->setExtendedName($_);
push @changeset, $element;
- } # foreach
+ } # for
$self->{changeset} = \@changeset;
return @changeset;
} # changeset
-sub create ($$$;$) {
- my ($self, $stream, $pvob, $headline, $opts) = @_;
+sub exists() {
+ my ($self) = @_;
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ 'lsactivity ' . $self->{name} . '@' . $self->pvob->tag
+ );
+
+ return !$status;
+} # exists
+
+sub create($$$;$) {
+ my ($self, $stream, $headline, $opts) = @_;
=pod
=over
-=item UCM Stream (required)
+=item UCM Stream(required)
UCM stream this activities is to be created on
=cut
- # Fill in members
- $self->{stream} = $stream;
- $self->{pvob} = $pvob;
-
- # TODO: Should quote $headline to protect from special characters
- $self->{headline} = $headline;
-
+ if ($self->exists) {
+ $self->updateActivityInfo;
+
+ return (0, ());
+ } # if
+
# Fill in opts
$opts ||= '';
- $opts .= " -headline '$headline'"
- if $headline;
+
+ if ($headline) {
+ $self->{headline} = $headline;
+
+ $opts .= " -headline '$headline'";
+ } # if
- # TODO: This should call the exists function
- # Return the stream name if the stream already exists
- my ($status, @output) =
- $Clearcase::CC->execute ('lsact -short ' . $self->{name});
+ $self->{stream} = Clearcase::UCM::Stream->new($stream, $self->{pvob});
- return ($status, @output)
- unless $status;
-
- # Need to create the stream
return $Clearcase::CC->execute
- ("mkactivity $opts -in " . $stream .
- "\@" . $pvob .
- ' ' . $self->{name});
+ ("mkactivity $opts -in " . $stream->{name} .
+ '@' . $self->pvob->{tag} .
+ ' ' . $self->{name} .
+ '@' . $self->pvob->{tag});
} # create
-sub remove () {
+sub remove() {
my ($self) = @_;
=pod
=cut
return $Clearcase::CC->execute
- ('rmactivity -f ' . $self->{name} . "\@" . $self->{pvob});
+ ('rmactivity -f ' . $self->{name} . "\@" . $self->{pvob}->name);
} # remove
-sub attributes (;%) {
+sub attributes(;%) {
my ($self, %newAttribs) = @_;
=pod
=cut
- return $self->Clearcase::attributes (
+ return $self->Clearcase::attributes(
'activity',
- "$self->{name}\@" . Clearcase::vobtag ($self->{pvob}),
+ "$self->{name}\@" . $self->{pvob}->name,
%newAttribs,
);
} # attributes
-sub updateActivityInfo () {
+sub updateActivityInfo() {
my ($self) = @_;
# Get all information that can be gotten using -fmt
$fmt = '%[contrib_acts]CXp==';
} # if
- $Clearcase::CC->execute (
- "lsactivity -fmt \"$fmt\" $self->{name}@" . Clearcase::vobtag ($self->{pvob})
+ $Clearcase::CC->execute(
+ "lsactivity -fmt \"$fmt\" $self->{name}@" . $self->{pvob}->name
);
# Assuming this activity is an empty shell of an object that the user may
$self->{contrib_acts} = ();
if ($self->type eq 'integration') {
- foreach (split ', ', $fields[7]) {
- push @{$self->{contrib_acts}}, Clearcase::UCM::Activity->new ($_);
- } # foreach
+ for (split ', ', $fields[7]) {
+ push @{$self->{contrib_acts}}, Clearcase::UCM::Activity->new($_);
+ } # for
} # if
return;
use Carp;
-use lib '../..';
-
-use Clearcase;
-use Clearcase::Element;
-use Clearcase::UCM::Activity;
-
-sub _processOpts (%) {
+sub _processOpts(%) {
my ($self, %opts) = @_;
my $opts;
-
- foreach (keys %opts) {
+
+ for (keys %opts) {
if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') {
$opts .= "-$_ ";
} elsif ($_ eq 'c' or $_ eq 'cfile') {
$opts .= "-$_ $opts{$_}";
} # if
- } # foreach
-
-
+ } # for
+
return $opts;
} # _processOpts
-sub new ($$) {
+sub new($$) {
my ($class, $baseline, $pvob) = @_;
=pod
=cut
- my $self = bless {
+ $class = bless {
name => $baseline,
- pvob => Clearcase::vobtag $pvob,
+ pvob => $pvob,
}, $class; # bless
-
- return $self;
+
+ return $class;
} # new
-sub name () {
+sub name() {
my ($self) = @_;
-
+
=pod
=head2 name
return $self->{name};
} # name
-sub pvob () {
+sub pvob() {
my ($self) = @_;
-
+
=pod
=head2 pvob
return $self->{pvob};
} # pvob
-
-sub create ($$;$$) {
- my ($self, $project, $pvob, $baseline, $opts) = @_;
+
+sub create($;$$$) {
+ my ($self, $view, $comment, $opts) = @_;
=pod
=head2 create
-Creates a new UCM Stream Object
+Creates a new UCM Baseline Object
Parameters:
=over
-=item UCM Project (required)
-
-UCM Project this stream belongs to
-
-=item PVOB (Required)
-
-Project Vob
-
-=item baseline
-
-Baseline to set this stream to
-
=item opts
-Options: Additional options to use (e.g. -readonly)
+Options: Additional options to use
=back
=cut
- # Fill in object members
- $self->{project} = $project;
- $self->{pvob} = $pvob;
-
- # Fill in opts
$opts ||= '';
- $opts .= " -baseline $baseline"
- if $baseline;
-
- $self->{readonly} = $opts =~ /-readonly/;
-
- # TODO: This should call the exists function
- # Return the stream name if the stream already exists
- my ($status, @output) =
- $Clearcase::CC->execute ('lsstream -short ' . $self->{name});
-
- return ($status, @output)
- unless $status;
-
- # Need to create the stream
- return $Clearcase::CC->execute
- ("mkstream $opts -in " . $self->{project} .
- "\@" . $self->{pvob} .
- ' ' . $self->{name});
+
+ $comment = Clearcase::_setComment $comment;
+
+ return $Clearcase::CC->execute(
+ "mkbl $comment $opts -view " . $view->tag . ' ' . $self->{name}
+ );
} # create
-sub remove (\%) {
- my ($self, %opts) = @_;
+sub remove($) {
+ my ($self, $opts) = @_;
=pod
=cut
- my $opts = $self->_processOpts (%opts);
-
- my $pvob = Clearcase::vobtag ($self->{pvob});
-
- my ($status, @output) = $Clearcase::CC->execute
- ("rmbl $opts " . $self->{name} . '@' . $pvob);
-
- return;
+ $opts ||= '';
+
+ return $Clearcase::CC->execute(
+ "rmbl $opts -force " . $self->{name} . '@' . $self->{pvob}->name
+ );
} # remove
sub attributes () {
=cut
- return $self->Clearcase::attributes (
+ return $self->Clearcase::attributes(
'baseline',
- "$self->{name}\@" . Clearcase::vobtag ($self->{pvob})
+ "$self->{name}\@" . $self->{pvob}->name
);
} # attributes
-sub diff ($;$$) {
+sub diff($;$$) {
my ($self, $type, $baseline, %opts) = @_;
-
+
=pod
=head2 diff
croak "Type must be one of activities, versions or baselines in "
. "Clearcase::UCM::Baseline::diff - not $type";
} # unless
-
+
my $myBaseline = "$self->{name}\@$self->{pvob}";
-
+
my $cmd = "diffbl -$type";
-
+
if ($baseline) {
if ($baseline =~ /(\S+):/) {
unless ($1 eq 'baseline' or $1 eq 'stream') {
. "just <baseline>";
} # unless
} # if
-
+
$baseline .= "\@$self->{pvob}" unless $baseline =~ /\@/;
-
+
$cmd .= " $myBaseline $baseline";
} else {
$cmd .= " -predeccsor";
} # if
-
- $Clearcase::CC->execute ($cmd);
-
+
+ $Clearcase::CC->execute($cmd);
+
return if $Clearcase::CC->status;
-
+
my @output = $Clearcase::CC->output;
my %info;
-
- foreach (@output) {
+
+ for (@output) {
next unless /^(\>\>|\<\<)/;
-
+
if (/(\>\>|\<\<)\s+(\S+)\@/) {
- $info{$2} = Clearcase::UCM::Activity->new ($2, $self->{pvob});
+ $info{$2} = Clearcase::UCM::Activity->new($2, $self->{pvob});
} # if
- } # foreach
-
+ } # for
+
return %info;
} # diff
--- /dev/null
+=pod
+
+=head1 NAME $RCSfile: Component.pm,v $
+
+Object oriented interface to UCM Component
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.8 $
+
+=item Created
+
+Fri May 14 18:16:16 PDT 2010
+
+=item Modified
+
+$Date: 2011/11/15 02:00:58 $
+
+=back
+
+=head1 SYNOPSIS
+
+Provides access to information about Clearcase Components.
+
+ my $stream = new Clearcase::UCM::Component($name, $pvob);
+
+=head1 DESCRIPTION
+
+This module implements a UCM Component object
+
+=head1 ROUTINES
+
+The following routines are exported:
+
+=cut
+
+package Clearcase::UCM::Component;
+
+use strict;
+use warnings;
+
+use Carp;
+
+sub new ($$) {
+ my ($class, $name, $pvob) = @_;
+
+=pod
+
+=head2 new
+
+Construct a new Clearcase Component object.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item name
+
+Name of Component
+
+=item pvob
+
+Associated pvob
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Clearcase Component object
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $class = bless {
+ name => $name,
+ pvob => $pvob,
+ }, $class; # bless
+
+ return $class;
+} # new
+
+sub name () {
+ my ($self) = @_;
+
+=pod
+
+=head2 name
+
+Returns the name of the component
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item name
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{name};
+} # name
+
+sub pvob () {
+ my ($self) = @_;
+
+=pod
+
+=head2 pvob
+
+Returns the pvob of the component
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item pvob
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{pvob};
+} # pvob
+
+sub create (;$$) {
+ my ($self, $root, $comment) = @_;
+
+=pod
+
+=head2 create
+
+Creates a new UCM Component Object
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return (0, ()) if $self->exists;
+
+ $comment = Clearcase::_setComment $comment;
+
+ my $rootOpt;
+
+ if ($root) {
+ if (-d $root) {
+ $self->{root} = $root;
+
+ $rootOpt = "-root $root";
+ } else {
+ carp "Root $root not found";
+ } # if
+ } else {
+ $self->{root} = undef;
+
+ $rootOpt = '-nroot';
+ } # if
+
+ return $Clearcase::CC->execute(
+ "mkcomp $comment $rootOpt " . $self->{name} . '@' . $self->{pvob}->tag
+ );
+} # create
+
+sub remove () {
+ my ($self) = @_;
+
+=pod
+
+=head2 remove
+
+Removes UCM Component
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute
+ ('rmcomp -f ' . $self->name . '@' . $self->pvob->tag);
+} # remove
+
+sub exists() {
+ my ($self) = @_;
+
+=pod
+
+=head3 exists
+
+Returns true if the component exists - false otherwise.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item boolean
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ 'lscomp ' . $self->{name} . '@' . $self->{pvob}->name
+ );
+
+ return !$status;
+} # exists
+
+1;
+
+=head1 DEPENDENCIES
+
+=head2 ClearSCM Perl Modules
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Baseline.pm">Clearcase::UCM::Baseline</a></p>
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Project.pm">Clearcase::UCM::Project</a></p>
+
+=head1 INCOMPATABILITIES
+
+None
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this module.
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
+
+=cut
--- /dev/null
+=pod
+
+=head1 NAME $RCSfile: Folder.pm,v $
+
+Object oriented interface to UCM Folders
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.8 $
+
+=item Created
+
+Fri May 14 18:16:16 PDT 2010
+
+=item Modified
+
+$Date: 2011/11/15 02:00:58 $
+
+=back
+
+=head1 SYNOPSIS
+
+Provides access to information about Clearcase Folders.
+
+ my $folder = new Clearcase::UCM::Folder ($name, $pvob);
+
+=head1 DESCRIPTION
+
+This module implements a UCM Folder object
+
+=head1 ROUTINES
+
+The following routines are exported:
+
+=cut
+
+package Clearcase::UCM::Folder;
+
+use strict;
+use warnings;
+
+sub new ($$;$$) {
+ my ($class, $name, $pvob, $parent, $comment) = @_;
+
+=pod
+
+=head2 new
+
+Construct a new Clearcase Folder object.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item folder
+
+Name of folder
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Clearcase Folder object
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $class = bless {
+ name => $name,
+ pvob => $pvob,
+ parent => $parent || 'RootFolder',
+ }, $class; # bless
+
+ $comment = Clearcase::_setComment ($comment);
+
+ my ($status, @output) = $Clearcase::CC->execute (
+ "mkfolder $comment -in " . $class->{parent} . ' ' . $name . '@' . $pvob->tag
+ );
+
+ return $class->updateFolderInfo;
+} # new
+
+sub name () {
+ my ($self) = @_;
+
+=pod
+
+=head2 name
+
+Returns the name of the folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item folder's name
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{name};
+} # name
+
+sub owner () {
+ my ($self) = @_;
+
+=pod
+
+=head2 owner
+
+Returns the owner of the folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item folder's owner
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{owner};
+} # owner
+
+sub group () {
+ my ($self) = @_;
+
+=pod
+
+=head2 group
+
+Returns the group of the folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item folder's group
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{group};
+} # group
+
+sub pvob () {
+ my ($self) = @_;
+
+=pod
+
+=head2 pvob
+
+Returns the pvob of the folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item folder's pvob
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{pvob};
+} # pvob
+
+sub title () {
+ my ($self) = @_;
+
+=pod
+
+=head2 title
+
+Returns the title of the folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item folder's title
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{title};
+} # title
+
+sub create ($;$) {
+ my ($self, $name, $parentFolder) = @_;
+
+=pod
+
+=head2 create
+
+Creates a new UCM Folder Object
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item name
+
+UCM Folder name
+
+=item parentFolder
+
+Name of parentFolder (Default: RootFolder)
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ # Fill in object members
+ $self->{parentFolder} = $parentFolder;
+
+ $parentFolder ||= 'RootFolder';
+
+ # Need to create the folder
+ return $Clearcase::CC->execute(
+ "mkfolder $self->{comment} -in " . $parentFolder . '@' . $self->{pvob} .
+ ' ' . $self->{name}
+ );
+} # create
+
+sub remove () {
+ my ($self) = @_;
+
+=pod
+
+=head2 remove
+
+Removes UCM Folder
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item name
+
+UCM Folder name
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Output from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute(
+ 'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}->tag);
+} # rmfolder
+
+sub updateFolderInfo () {
+ my ($self) = @_;
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ "lsfolder -long $self->{name}" . '@'. $self->{pvob}->tag);
+
+ return if $status;
+
+ for (@output) {
+ if (/owner: (.*)/) {
+ $self->{owner} = $1;
+ } elsif (/group: (.*)/) {
+ $self->{group} = $1;
+ } elsif (/title: (.*)/) {
+ $self->{title} = $1;
+ # TODO: Get containing folders and containing projects
+ } # if
+ } # for
+
+ return $self;
+} # updateFolderInfo
+1;
+
+=head1 DEPENDENCIES
+
+=head2 ClearSCM Perl Modules
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Baseline.pm">Clearcase::UCM::Baseline</a></p>
+
+=head1 INCOMPATABILITIES
+
+None
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this module.
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
+
+=cut
--- /dev/null
+=pod
+
+=head1 NAME $RCSfile: Project.pm,v $
+
+Object oriented interface to UCM Projects
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.8 $
+
+=item Created
+
+Fri May 14 18:16:16 PDT 2010
+
+=item Modified
+
+$Date: 2011/11/15 02:00:58 $
+
+=back
+
+=head1 SYNOPSIS
+
+Provides access to information about Clearcase UCM Projects.
+
+ my $project = new Clearcase::UCM::Project ($name, $folder, $pvob);
+
+=head1 DESCRIPTION
+
+This module implements a UCM Project object
+
+=head1 ROUTINES
+
+The following routines are exported:
+
+=cut
+
+package Clearcase::UCM::Project;
+
+use strict;
+use warnings;
+
+sub new ($$) {
+ my ($class, $name, $folder, $pvob) = @_;
+
+=pod
+
+=head2 new
+
+Construct a new Clearcase Project object.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item project
+
+Name of project
+
+=item folder
+
+Folder object
+
+=item pvob
+
+Associated Pvob
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Clearcase Project object
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $folder = Clearcase::UCM::Folder->new('RootFolder', $pvob) unless $folder;
+
+ $class = bless {
+ name => $name,
+ folder => $folder,
+ pvob => $pvob,
+ }, $class; # bless
+
+ return $class;
+} # new
+
+sub name () {
+ my ($self) = @_;
+
+=pod
+
+=head2 name
+
+Returns the name of the project
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item project's name
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{name};
+} # name
+
+sub pvob () {
+ my ($self) = @_;
+
+=pod
+
+=head2 pvob
+
+Returns the pvob of the project
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item project's pvob
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{pvob};
+} # pvob
+
+sub create (;$) {
+ my ($self, $opts) = @_;
+
+=pod
+
+=head2 create
+
+Creates a new UCM Project Object
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item opts
+
+Optional parameters for cleartool mkproject command
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return (0, ()) if $self->exists;
+
+ $opts ||= '';
+
+ return $Clearcase::CC->execute(
+ "mkproject $opts -in " . $self->{folder}->name . '@' . $self->{pvob}->tag .
+ ' ' . $self->{name} . '@' . $self->{pvob}->tag
+ );
+} # create
+
+sub remove () {
+ my ($self) = @_;
+
+=pod
+
+=head2 remove
+
+Removes UCM Project
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute
+ ('rmproject -f ' . $self->{name} . "\@" . $self->{pvob}->tag);
+} # remove
+
+sub change($) {
+ my ($self, $opts) = @_;
+
+=pod
+
+=head2 change
+
+Changes UCM Project
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item opts
+
+Options
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $opts ||= '';
+
+ return $Clearcase::CC->execute
+ ("chproject $opts " . $self->{name} . "\@" . $self->{pvob}->name);
+} # change
+
+sub exists() {
+ my ($self) = @_;
+
+=pod
+
+=head3 exists
+
+Returns true if the project exists - false otherwise
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item boolean
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ 'lsproject ' . $self->{name} . '@' . $self->{pvob}->name
+ );
+
+ return !$status;
+} # exists
+
+1;
+
+=head1 DEPENDENCIES
+
+=head2 ClearSCM Perl Modules
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Folder.pm">Clearcase::UCM::Folder</a></p>
+
+=head1 INCOMPATABILITIES
+
+None
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this module.
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
+
+=cut
use strict;
use warnings;
-use Clearcase;
-use Clearcase::UCM::Stream;
+# Would be better represented by use parent "Clearcase::Vob" but we're
+# working with old versions of Perl here...
+use base 'Clearcase::Vob';
+
+use Carp;
sub new ($) {
- my ($class, $name) = @_;
+ my ($class, $tag) = @_;
=pod
=over
-=item pvob name
+=item name
Name of pvob
=cut
- my $self = bless {
- name => $name,
+ croak 'Clearcase::UCM::Pvob: Must specify pvob tag' unless $tag;
+
+ $class = bless {
+ tag => $tag,
}, $class; # bless
- return $self;
+ $class->updateVobInfo;
+
+ return $class;
} # new
-sub name () {
+sub create (;$$$%) {
+ my ($self, $host, $vbs, $comment, %opts) = @_;
+
+=pod
+
+=head2 create
+
+Creates a pvob
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ $opts{ucmproject} = undef;
+
+ return $self->SUPER::create ($host, $vbs, $comment, %opts);
+} # create
+
+sub tag() {
my ($self) = @_;
=pod
-=head2 name
+=head2 tag
-Returns the name of the pvob
+Returns the tag of the pvob
Parameters:
=over
-=item pvob's name
+=item tag
=back
=cut
- return $self->{name};
+ return $self->{tag};
+} # tag
+
+# Alias name to tag
+sub name() {
+ goto &tag;
} # name
sub streams () {
my @streams;
push @streams, Clearcase::UCM::Stream->new ($_, $self->{name})
- foreach ($Clearcase::CC->output);
+ for ($Clearcase::CC->output);
return @streams;
} # streams
=head1 SYNOPSIS
-Provides access to information about Clearcase Elements.
+Provides access to information about Clearcase Streams.
- my $stream= new Clearcase::UCM::Stream ($name, $pvob);
+ my $stream = new Clearcase::UCM::Stream ($name, $pvob);
=head1 DESCRIPTION
use strict;
use warnings;
-use Clearcase;
-use Clearcase::UCM::Baseline;
-
sub new ($$) {
- my ($class, $stream, $pvob) = @_;
+ my ($class, $name, $pvob) = @_;
=pod
=over
-=item stream name
+=item name
Name of stream
+=item pvob
+
+Associated pvob
+
=back
=for html </blockquote>
=cut
- my $self = bless {
- name => $stream,
- pvob => Clearcase::vobtag $pvob,
+ $class = bless {
+ name => $name,
+ pvob => $pvob,
}, $class; # bless
-
- return $self;
+
+ return $class;
} # new
-
+
sub name () {
my ($self) = @_;
-
+
=pod
=head2 name
sub pvob () {
my ($self) = @_;
-
+
=pod
=head2 pvob
return $self->{pvob};
} # pvob
-
-sub create ($$;$$) {
- my ($self, $project, $pvob, $baseline, $opts) = @_;
+
+sub create ($;$) {
+ my ($self, $project, $opts) = @_;
=pod
=over
-=item UCM Project (required)
-
-UCM Project this stream belongs to
-
-=item PVOB (Required)
-
-Project Vob
+=item project
-=item baseline
-
-Baseline to set this stream to
+Project that this stream will be created in
=item opts
-Options: Additional options to use (e.g. -readonly)
+Options: Additional options to use (e.g. -baseline/-readonly)
=back
=cut
- # Fill in object members
- $self->{project} = $project;
- $self->{pvob} = $pvob;
-
- # Fill in opts
+ return (0, ()) if $self->exists;
+
$opts ||= '';
- $opts .= " -baseline $baseline"
- if $baseline;
-
+
$self->{readonly} = $opts =~ /-readonly/;
-
- # TODO: This should call the exists function
- # Return the stream name if the stream already exists
- my ($status, @output) =
- $Clearcase::CC->execute ('lsstream -short ' . $self->{name});
-
- return ($status, @output)
- unless $status;
-
- # Need to create the stream
- return $Clearcase::CC->execute
- ("mkstream $opts -in " . $self->{project} .
- "\@" . $self->{pvob} .
- ' ' . $self->{name});
+
+ return $Clearcase::CC->execute(
+ "mkstream $opts -in "
+ . $project->name . '@' . $self->{pvob}->tag . ' '
+ . $self->name . '@' . $self->{pvob}->tag
+ );
} # create
sub remove () {
=over
-=item UCM Project (required)
+=back
-UCM Project this stream belongs to
+=for html </blockquote>
-=item PVOB (Required)
+Returns:
+
+=for html <blockquote>
-Project Vob
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute
+ ('rmstream -f ' . $self->{name} . '@' . $self->{pvob}->name);
+} # rmStream
+
+sub rebase($;$) {
+ my ($self, $opts) = @_;
+
+=pod
+
+=head2 rebase
+
+Rebases a UCM Stream
+
+Parameters:
+
+=for html <blockquote>
+
+=over
=item baseline
-Baseline to set this stream to
+Baseline to rebase to
=item opts
-Options: Additional options to use (e.g. -readonly)
+Any additional opts
=back
=cut
- return $Clearcase::CC->execute
- ('rmstream -f ' . $self->{name} . "\@" . $self->{pvob});
-} # rmStream
+ $opts ||= '';
+
+ $opts .= ' -stream ' . $self->name . '@' . $self->{pvob}->name;
+
+ return $Clearcase::CC->execute("rebase $opts");
+} # rebase
+
+sub recommend($) {
+ my ($self, $baseline) = @_;
+
+=pod
+
+=head2 recommend
+
+Recommends a baseline in a UCM Stream
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item baseline
+
+Baseline to recommend
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute(
+ "chstream -recommended $baseline " . $self->name . '@' . $self->{pvob}->tag
+ );
+} # recommend
+
+sub nrecommended() {
+ my ($self) = @_;
+
+=pod
+
+=head2 nrecommend
+
+Changes stream to not have a recommended baseline
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item $status
+
+Status from cleartool
+
+=item @output
+
+Ouput from cleartool
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $Clearcase::CC->execute(
+ 'chstream -nrecommended ' . $self->name . '@' . $self->{pvob}->tag
+ );
+} # nrecommended
sub baselines () {
my ($self) = @_;
=cut
my $cmd = "lsbl -short -stream $self->{name}\@$self->{pvob}";
-
+
$Clearcase::CC->execute ($cmd);
return if $Clearcase::CC->status;
my @baselines;
-
- foreach ($Clearcase::CC->output) {
+
+ for ($Clearcase::CC->output) {
my $baseline = Clearcase::UCM::Baseline->new ($_, $self->{pvob});
-
+
push @baselines, $baseline;
- } # foreach
-
+ } # for
+
return @baselines;
} # baselines
+sub exists() {
+ my ($self) = @_;
+
+=pod
+
+=head3 exists
+
+Return true if the stream exists - false otherwise
+
+Paramters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item boolean
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($status, @output) = $Clearcase::CC->execute(
+ 'lsstream ' . $self->{name} . '@' . $self->{pvob}->name
+ );
+
+ return !$status;
+} # exists
+
1;
=head1 DEPENDENCIES
=for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Baseline.pm">Clearcase::UCM::Baseline</a></p>
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase/UCM/Project.pm">Clearcase::UCM::Project</a></p>
=head1 INCOMPATABILITIES
--- /dev/null
+=pod
+
+=head1 NAME $RCSfile: Stream.pm,v $
+
+Object oriented interface to UCM Streams
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 1.8 $
+
+=item Created
+
+Fri May 14 18:16:16 PDT 2010
+
+=item Modified
+
+$Date: 2011/11/15 02:00:58 $
+
+=back
+
+=head1 SYNOPSIS
+
+Provides access to information about Clearcase Streams.
+
+ my $stream = new Clearcase::UCM::Streams()
+
+=head1 DESCRIPTION
+
+This module implements a UCM Streams object
+
+=head1 ROUTINES
+
+The following routines are exported:
+
+=cut
+
+package Clearcase::UCM::Streams;
+
+use strict;
+use warnings;
+
+sub new ($) {
+ my ($class, $pvob) = @_;
+
+=pod
+
+=head2 new
+
+Construct a new Clearcase Streams object
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item pvob
+
+Pvob object
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Clearcase Streams object
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ my ($status, @output) =
+ $clearcase::CC->execute('lsstream -short -invob ' . $pvob->tag;
+
+ my $class = bless {
+ streams => @output,
+ }, $class; # bless
+
+ return $class;
+} # new
+
+sub streams () {
+ my ($self) = @_;
+
+=pod
+
+=head2 streams
+
+Return a list of stream names in an array context or the number of streams in
+a scalar context.
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item List of streams or number of streams
+
+Array of stream names in an array context or the number of streams in a scalar
+context.
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ if (wantarray) {
+ return $self->{streams} ? sort @{$self->{streams}) : ();
+ } else {
+ return $self->{streams} ? scalar @{$self->{streams});
+ } # if
+} # streams
+
+1;
+
+=head1 DEPENDENCIES
+
+=head2 ClearSCM Perl Modules
+
+=for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
+
+=head1 INCOMPATABILITIES
+
+None
+
+=head1 BUGS AND LIMITATIONS
+
+There are no known bugs in this module.
+
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
+
+=cut
--- /dev/null
+WOR: RANCQ00090968
+UCM Project: test6@/vobs/killme_pvob
use Clearcase;
use Display;
-sub new ($;$) {
- my ($class, $tag, $region) = @_;
+sub new ($) {
+ my ($class, $tag) = @_;
=pod
my $self = bless { tag => $tag }, $class;
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return $self;
} # new
return $self->{tag};
} # tag
+# Alias name to tag
+sub name() {
+ goto &tag;
+} # name
+
sub text_mode () {
my ($self) = @_;
} # exists
sub create (;$$$) {
- my ($self, $host, $vws, $region) = @_;
+ my ($self, $host, $vws, $opts) = @_;
=pod
=cut
- $region ||= $Clearcase::CC->region;
-
if ($self->exists) {
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return (0, ())
} # if
my ($status, @output);
+ $opts ||= '';
+
if ($host && $vws) {
- ($status, @output) =
- $Clearcase::CC->execute ("mkview -tag $self->{tag} -region $region "
- . "-host $host -hpath $vws -gpath $vws $vws");
+ ($status, @output) = $Clearcase::CC->execute(
+ "mkview -tag $self->{tag} $opts " .
+ "-host $host -hpath $vws -gpath $vws $vws"
+ );
} else {
# Note this requires that -stgloc's work and that using -auto is not a
# problem.
- ($status, @output) =
- $Clearcase::CC->execute ("mkview -tag $self->{tag} -stgloc -auto");
+ ($status, @output) = $Clearcase::CC->execute(
+ "mkview -tag $self->{tag} $opts -stgloc -auto"
+ );
} # if
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return ($status, @output);
} # create
+# TODO Is this used?
sub createUCM ($$) {
- my ($self, $stream, $pvob, $region) = @_;
+ my ($self, $stream, $pvob) = @_;
=pod
=cut
- $region ||= $Clearcase::CC->region;
-
- return (0, ())
- if $self->exists;
+ return (0, ()) if $self->exists;
# Update object members
- $self->{stream} = $stream;
- $self->{pvob} = $pvob;
+ $self->{pvob} = $pvob;
# Need to create the view
my ($status, @output) =
return ($status, @output)
if $status;
- $self->updateViewInfo ($region);
+ $self->updateViewInfo;
return ($status, @output);
} # createUCM
=cut
- return (0, ())
- unless $self->exists;
+ return (0, ()) unless $self->exists;
my ($status, @output);
if ($self->dynamic) {
+ $self->stop;
+
($status, @output) = $Clearcase::CC->execute (
"rmview -force -tag $self->{tag}"
);
return ($status, @output);
} # set
-sub updateViewInfo ($$) {
- my ($self, $region) = @_;
-
- $region ||= $Clearcase::CC->region;
+sub updateViewInfo () {
+ my ($self) = @_;
my ($status, @output) = $Clearcase::CC->execute (
- "lsview -region $region -long -properties -full $self->{tag}"
+ "lsview -long -properties -full $self->{tag}"
);
# Assuming this view is an empty shell of an object that the user may possibly
return $self->{shost};
} # shost
+# Alias name to tag
+sub name() {
+ goto &tag;
+} # name
sub access () {
my ($self) = @_;
return !$status;
} # exists
-sub create (;$$$) {
- my ($self, $host, $vbs, $comment) = @_;
+sub create (;$$$%) {
+ my ($self, $host, $vbs, $comment, %opts) = @_;
=pod
return (0, ()) if $self->exists;
- $comment = Clearcase::setComment $comment;
+ $comment = Clearcase::_setComment $comment;
my ($status, @output);
+ my $additionalOpts = '';
+
+ for (keys %opts) {
+ $additionalOpts .= "-$_ ";
+ $additionalOpts .= "$opts{$_} " if $opts{$_};
+ } # for
+
if ($host && $vbs) {
($status, @output) = $Clearcase::CC->execute (
- "mkvob -tag $self->{tag} $comment -host $host -hpath $vbs "
+ "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs "
. "-gpath $vbs $vbs");
} else {
# Note this requires that -stgloc's work and that using -auto is not a
# problem.
($status, @output) =
- $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment "
- . "-stgloc -auto");
+ $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto");
} # if
$self->updateVobInfo;
# Strip $VOBTAG_PREFIX
foreach (@output) {
- if ($ARCH eq 'windows' or $ARCH eq 'cygwin') {
+ if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') {
s/\\//;
} else {
s/$Clearcase::VOBTAG_PREFIX//;
END {
# Insure all instaniated objects have been destroyed
- $_->DESTROY foreach (@objects);
+ $_->DESTROY for (@objects);
} # END
# Internal methods
} # if
unless (@fields) {
- # Always return dbid
- push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields;
-
- foreach (@{$entityDef->GetFieldDefNames}) {
+ for (@{$entityDef->GetFieldDefNames}) {
unless ($self->{returnSystemFields}) {
next if $entityDef->IsSystemOwnedFieldDefName ($_);
} # unless
push @fields, $_;
- } # foreach
+ } # for
} # unless
+ # Always return dbid
+ push @fields, 'dbid' unless grep {$_ eq 'dbid'} @fields;
+
return @fields;
} # _setFields
# evaluate $fieldValue if $fieldValue is a simple number (e.g. 0, 1, etc.)
$errmsg = $entity->SetFieldValue ($fieldName, "$fieldValue") if $fieldValue;
} else {
- foreach (@$fieldValue) {
+ for (@$fieldValue) {
$errmsg = $entity->AddFieldValue ($fieldName, $_);
return $errmsg unless $errmsg eq '';
- } # foreach
+ } # for
} # unless
return $errmsg;
} # if
# First process all fields in @ordering, if specified
- foreach (@ordering) {
+ for (@ordering) {
if ($values{$_}) {
$self->{errmsg} = $self->_setFieldValue ($entity, $table, $_, $values{$_});
} else {
} # if
last unless $self->{errmsg} eq '';
- } # foreach
+ } # for
return unless $self->{errmsg} eq '';
# Now process the rest of the values
- foreach my $fieldName (keys %values) {
+ for my $fieldName (keys %values) {
next if grep {$fieldName eq $_} @ordering;
$self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
last unless $self->{errmsg} eq '';
- } # foreach
+ } # for
$self->_setError ($self->{errmsg});
return $connectionStr;
} # connection
-sub checkErr (;$$) {
- my ($self, $msg, $die) = @_;
+sub checkErr (;$$$) {
+ my ($self, $msg, $die, $log) = @_;
=pod
} # if
if ($die) {
- croak $msg if $die;
+ $log->err ($msg) if $log;
+ croak $msg;
} else {
- print STDERR "$msg\n";
+ if ($log) {
+ $log->err($msg);
+ } else {
+ print STDERR "$msg\n";
+ } # if
return $self->{error};
} # if
=cut
+ # Watch here as $error can very well be 0 which "if $error" would evaluate
+ # to false leaving $self->{error} undefined
$self->{error} = $error if defined $error;
return $self->{error};
my $entityDef = $self->{session}->GetEntityDef ($table);
- foreach (@{$entityDef->GetFieldDefNames}) {
+ for (@{$entityDef->GetFieldDefNames}) {
$FIELDS{$table}{$_} = $entityDef->GetFieldDefType ($_);
- } # foreach
+ } # for
if (defined $FIELDS{$table}{$fieldName}) {
return $FIELDS{$table}{$fieldName}
my $query = $self->{session}->BuildQuery ($table);
- foreach (@fields) {
+ for (@fields) {
eval {$query->BuildField ($_)};
if ($@) {
carp $@;
} # if
- } # foreach
+ } # for
$self->_parseConditional ($query, $condition);
my %record;
- foreach (@fields) {
+ for (@fields) {
my $fieldType = $entity->GetFieldValue ($_)->GetType;
if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
$record{$_} = _UTC2Localtime ($record{$_});
} # if
} # if
- } # foreach
+ } # for
$self->_setError;
@fields = $self->_setFields ($table, @fields);
- return if @fields;
-
my $entity;
eval {$entity = $self->{session}->GetEntityByDbId ($table, $dbid)};
my %record;
- foreach (@fields) {
+ for (@fields) {
my $fieldType = $entity->GetFieldValue ($_)->GetType;
if ($fieldType == $CQPerlExt::CQ_REFERENCE_LIST) {
$record{$_} = _UTC2Localtime ($record{$_});
} # if
} # if
- } # foreach
+ } # for
$self->_setError;
# Format %record
while ($column <= $nbrColumns) {
- my $value = $result->{result}->GetColumnValue ($column);
-
- $value ||= '' if $self->{emptyStringForUndef};
+ my $name = $result->{result}->GetColumnLabel($column);
+ my $value = $result->{result}->GetColumnValue($column++);
# Fix any UTC dates - _UTC2Localtime will only modify data if the data
# matches a UTC datetime.
- $value = _UTC2Localtime ($value);
+ $value = _UTC2Localtime ($value) if $value;
- $record{$result->{result}->GetColumnLabel ($column++)} = $value;
+ $value ||= '' if $self->{emptyStringForUndef};
+
+ $record{$name} = $value;
} # while
%{$result->{lastRecord}} = %record unless $result->{lastRecord};
if ($result->{thisDBID} == $result->{lastDBID}) {
# Since the dbid's are the same, we have at least one reference list field
# and we need to compare all fields
- foreach my $field (keys %record) {
+ for my $field (keys %record) {
# If the field is blank then skip it
next if $record{$field} eq '';
push @{$result->{lastRecord}{$field}}, $record{$field}
unless grep {/^$record{$field}$/} @{$result->{lastRecord}{$field}};
} # if
- } # foreach
+ } # for
# Transfer %lastRecord -> %record
%record = %{$result->{lastRecord}};
$self->_setError;
+ # Never return dbid...
+ delete $record{dbid};
+
return %record;
} # getNext
=cut
$action ||= 'Modify';
- my %values = %$values;
+ my %values = ();
+
+ %values = %$values if $values;
my $entity;
} # if
# First process all fields in @ordering, if specified
- foreach (@ordering) {
+ for (@ordering) {
if ($values{$_}) {
$self->{errmsg} = $self->_setFieldValue ($table, $_, $values{$_});
} else {
} # if
last unless $self->{errmsg} eq '';
- } # foreach
+ } # for
return $self->{errmsg} unless $self->{errmsg} eq '';
# Now process the rest of the values
- foreach my $fieldName (keys %values) {
+ for my $fieldName (keys %values) {
next if grep {$fieldName eq $_} @ordering;
$self->{errmsg} = $self->_setFieldValue ($entity, $table, $fieldName, $values{$fieldName});
last unless $self->{errmsg} eq '';
- } # foreach
+ } # for
$self->_setError ($self->{errmsg});
$msg = "ERROR: $msg";
} # if
- $self->log ($msg);
+ $self->msg($msg);
$self->incrementErr;
module as well as provide convienent references and mechanisms for
doing things that are different on different OSes.
- print "Running on $ARCH\n";
+ print "Running on $ARCHITECTURE\n";
`$cmd > $NULL 2>&1`;
my $filename = $app_base . $SEPARATOR . "datafile.txt";
=head1 DESCRIPTION
This module exports several variables that are useful to isolate OS
-dependencies. For example, $ARCH is set to "windows", "cygwin" or the
+dependencies. For example, $ARCHITECTURE is set to "windows", "cygwin" or the
value of $^O depending on which OS the script is running. This allows
you to write code that is dependant on which OS you are running
on. Similarly, $NULL is set to the string "NUL" when running on
use base 'Exporter';
-our $ARCH = $^O =~ /MSWin/
- ? 'windows'
- : $^O =~ /cygwin/
- ? "cygwin"
- : $^O;
-our $NULL = $^O =~ /MSWin/ ? 'NUL' : '/dev/null';
-our $SEPARATOR = $^O =~ /MSWin/ ? '\\' : '/';
-our $TRUE = 1;
-our $FALSE = 0;
-our $ROOT = $^O =~ /MSWin/ ? $ENV {SYSTEMDRIVE} . $SEPARATOR : "/";
+our $ARCHITECTURE = $^O =~ /MSWin/
+ ? 'windows'
+ : $^O =~ /cygwin/
+ ? "cygwin"
+ : $^O;
+our $NULL = $^O =~ /MSWin/ ? 'NUL' : '/dev/null';
+our $SEPARATOR = $^O =~ /MSWin/ ? '\\' : '/';
+our $TRUE = 1;
+our $FALSE = 0;
+our $ROOT = $^O =~ /MSWin/ ? $ENV {SYSTEMDRIVE} . $SEPARATOR : "/";
our @EXPORT = qw (
- $ARCH
+ $ARCHITECTURE
$FALSE
$NULL
$SEPARATOR
=cut
- if ($ARCH eq "windows" or $ARCH eq "cygwin") {
+ if ($ARCHITECTURE eq "windows" or $ARCHITECTURE eq "cygwin") {
# Not sure how this relates to Windows/Cygwin environment so just
# return false
return $FALSE;
=over
-=item $ARCH
+=item $ARCHITECTURE
Set to either "windows", "cygwin" or $^O.
or error "Can't write to $errorlog ($!)", 1;
# Change the current directory to /
- my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
+ my $ROOT = $ARCHITECTURE eq "windows" ? "C:\\" : "/";
chdir $ROOT
or error "Can't chdir to $ROOT ($!), 1";
=cut
- # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later.
- # Helps when you are doing process handling.
- my $sigchld = $SIG{CHLD};
-
local $SIG{CHLD} = 'DEFAULT';
my @output = `$cmd`;
my $status = $?;
- local $SIG{CHLD} = $sigchld;
-
chomp @output;
return ($status, @output);
while () {
my $key;
- while (not defined ($key = ReadKey -1)) { }
+ while (not defined ($key = ReadKey -1)) { }
if ($key =~ /(\r|\n)/) {
print "\n";
################################################################################
#
# File: $RCSfile: bash_login,v $
-# Revision: $Revision: 1.29 $
+# Revision: $Revision: 1.29 $
# Description: bash startup file
# Author: Andrew@DeFaria.com
# Created: Mon Aug 20 17:35:01 2001
echo "Warning: Unknown architecture ($KERNEL)"
fi
-# Architectual differences (AKA Silly Sun)
-if [ $ARCHITECTURE = "sun" ]; then
- alias id=/usr/xpg4/bin/id
- alias tr=/usr/xpg4/bin/tr
-
- export id=/usr/xpg4/bin/id
+# Hack: Just set TERM to xterm
+if [ $ARCHITECTURE = 'sun' ]; then
+ id=/usr/xpg4/bin/id
+ tr=/usr/xpg4/bin/tr
+ TERM=xtermc
+else
+ id=id
+ tr=tr
+ if [ $ARCHITECTURE = 'cygwin' ]; then
+ TERM=cygwin
+ else
+ TERM=xterm
+ fi
fi
# Set colors
export SYSNAME="*Unknown Systemname*:"
fi
-# System dependencies
-# Note: I don't like doing this but an alias doesn't work...
-if [ $ARCHITECTURE = "sun" ]; then
- id=/usr/xpg4/bin/id
-else
- id=id
-fi
-
umask 002
if [ "$interactive" = "true" ]; then
set +u
# Shell options
-if [ $ARCHITECTURE != 'Darwin' ]; then
- if ! grep -qP '5\.(6|7|8|9|10)' /etc/*release; then
- shopt -s autocd > /dev/null 2>&1
- shopt -s dirspell > /dev/null 2>&1
+if [ $ARCHITECTURE != 'Darwin' -a $ARCHITECTURE != 'sun' ]; then
+ ls /etc/*release > /dev/null 2>&1
+
+ if [ $? = 0 ]; then
+ if ! grep -qP '5\.(6|7|8|9|10)' /etc/*release; then
+ shopt -s autocd > /dev/null 2>&1
+ shopt -s dirspell > /dev/null 2>&1
+ fi
fi
fi
"$TERM" = "sun-color" -o \
"$TERM" = "vt100" -o \
"$TERM" = "vt220" -o \
+ "$TERM" = "xtermc" -o \
"$TERM" = "xterm" -o \
"$TERM" = "xterm-256color" -o \
"$TERM" = "cygwin" ]; then
export GIT_SSH=/usr/bin/ssh
# Now go home (in case we were not autmatically cd'ed there)
-if [ $(id -u) -ne 0 ]; then
+if [ $($id -u) -ne 0 ]; then
cd
fi
#
################################################################################
if [ $ARCHITECTURE = 'cygwin' ]; then
- export CCHOME=$(cygpath -u "$(regtool get '/machine/SOFTWARE/Rational Software/RSINSTALLDIR' 2>/dev/null)"/Clearcase 2>/dev/null);
+ # The following should work but fails because they are using /c to mount
+ # the C drive and that messes things up.
+ export CCHOME=$(cygpath -u "$(regtool get '/machine/SOFTWARE/Atria/ClearCase/CurrentVersion/ProductHome' 2>/dev/null)" 2>/dev/null)
+ export CCHOME=/opt/rational/clearcase
else
export CCHOME="/opt/rational/clearcase"
fi
fi
} # _object_selector
-complete -o default -F _scm scm ct
-
-complete -F _catcs catcs
-complete -F _checkin ci
-complete -F _deliver deliver
-complete -F _endview endview
-complete -F _lsactivity lsact
-complete -F _lsbl lsbl
-complete -F _lsproject lsproj
-complete -F _lsfolder lsfolder llfolder
-complete -F _lsstgloc lsstgloc
-complete -F _lsstream lsstream llstream
-complete -F _lsview lsview llview
-complete -F _lsvob lsvob llvob
-complete -F _merge merge
-complete -F _mktag mktag
-complete -F _mkview mkview
-complete -F _rebase rebase
-complete -F _rmtag rmtag
-complete -F _rmview rmview
-complete -F _setactivity setact
-complete -F _setcs setcs
-complete -F _setview setview
-complete -F _startview startview
-complete -F _space space
-complete -F _register register
-complete -F _uncheckout unco
-complete -F _unregister unregister
-
-complete -F _object_selector -o nospace lstype
-complete -F _object_selector -o nospace lltype
-complete -F _object_selector -o nospace lslock
-complete -F _object_selector -o nospace lllock
+if [[ $BASH_VERSION = 2.05* || $BASH_VERSION = 4* ]]; then
+ complete -o default -F _scm scm ct
+
+ complete -F _catcs catcs
+ complete -F _checkin ci
+ complete -F _deliver deliver
+ complete -F _endview endview
+ complete -F _lsactivity lsact
+ complete -F _lsbl lsbl
+ complete -F _lsproject lsproj
+ complete -F _lsfolder lsfolder llfolder
+ complete -F _lsstgloc lsstgloc
+ complete -F _lsstream lsstream llstream
+ complete -F _lsview lsview llview
+ complete -F _lsvob lsvob llvob
+ complete -F _merge merge
+ complete -F _mktag mktag
+ complete -F _mkview mkview
+ complete -F _rebase rebase
+ complete -F _rmtag rmtag
+ complete -F _rmview rmview
+ complete -F _setactivity setact
+ complete -F _setcs setcs
+ complete -F _setview setview
+ complete -F _startview startview
+ complete -F _space space
+ complete -F _register register
+ complete -F _uncheckout unco
+ complete -F _unregister unregister
+else
+ : echo 'Clearcase command completion broken on old Sun Bash shells'
+fi
+
+if [[ $BASH_VERSION = 4* ]]; then
+ complete -F _object_selector -o nospace lstype
+ complete -F _object_selector -o nospace lltype
+ complete -F _object_selector -o nospace lslock
+ complete -F _object_selector -o nospace lllock
+elif [[ $BASH_VERSION = 2.05* ]]; then
+ complete -F _object_selector lstype
+ complete -F _object_selector lltype
+ complete -F _object_selector lslock
+ complete -F _object_selector lllock
+ #echo 'Clearcase command completion partially broken on old Sun Bash shells'
+fi
export LINUX_VOBTAG_PREFIX=/vob
# The default pvob
-export pvob=${VOBTAG_PREFIX}9200_projects
+export pvob=${VOBTAG_PREFIX}
# The default vob
-export dvob="${VOBTAG_PREFIX}9200"
+export dvob=${VOBTAG_PREFIX}
################################################################################
umask 002
-export SITE_PERLLIB=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib
-export PATH=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/clearcase:$PATH
+if [ -d /cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib ]; then
+ export PERL5LIB=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib:$PERL5LIB
+fi
-export http_proxy=webgate0.gddsi.com:8080
-export ftp_proxy=webgate0.gddsi.com
+# This no longer work
+#export http_proxy=webgate0.gddsi.com:8080
+#export ftp_proxy=webgate0.gddsi.com
export QTDIR="/usr/local/Trolltech/Qt-4.2.2"
export QMAKESPEC="$QTDIR/mkspecs/solaris-cc"
export CCASE_MAKE_COMPAT=gnu
-export CQ_HOME=/opt/rational/clearquest
export CQ_HELP_BROWSER=firefox
export CQ_PERLLIB=/opt/rational/common/lib/perl5/5.6.1/sun4-solaris-multi:/opt/rational/common/lib/perl5/5.6.1:/opt/rational/common/lib/perl5/site_perl/5.6.1/sun4-solaris-multi:/opt/rational/common/lib/perl5/site_perl/5.6.1:/opt/rational/common/lib/perl5/site_perl
export RSU_LICENSE_MAP="/prj/muosran/config/Rational_License_Map"
-export LM_LICENSE_FILE="flex2:1850@flex2:15280@ranadm2:19353@ranadm2:19355@ranadm2:2468@ranadm2:1717@flex2:1711@bartlett:1711@flex3:27000@ranadm2:28000@ranadm2:5270@flex2"
-
-alias xemacs="ssh muosbldforge2 xemacs"
-
-export EDITOR="ssh muosbldforge2 xemacs"
+export LM_LICENSE_FILE="1850@ma06app30:flex2:1850@flex2:15280@ranadm2:19353@ranadm2:19355@ranadm2:2468@ranadm2:1717@flex2:1711@bartlett:1711@flex3:27000@ranadm2:28000@ranadm2:5270@flex2"
if [ $(uname) = "SunOS" ]; then
export QTDIR=/usr/local/Trolltech/Qt-4.2.2
export ORACLE_HOME="/usr/local/oracle/product/9.2"
- export CQ_HOME=/opt/rational/clearquest/
+ export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/usr/X11R6/lib:/usr/local/lib
elif [ $(uname) = "Linux" ]; then
export QTDIR=/usr/local/Trolltech/Qt-4.2.3
export ORACLE_HOME="/usr/local/oracle/product/10.2.0"
export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/usr/X11R6/lib
-fi
\ No newline at end of file
+fi
+
+# Where the Clearcase view drive is on Windows
+export CLEARCASE_VIEW_DRIVE=X
+
+# Additional paths...
+append_to_path "/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/clearcase"
+append_to_path "/cygcrive/c/Program Files/IBM/RationalSDLC/common"
+append_to_path "/cygcrive/d/Program Files/IBM/RationalSDLC/common"
+append_to_path "/cygcrive/c/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin"
+append_to_path "/cygcrive/d/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin"
+append_to_path "/cygcrive/c/Program Files/IBM/RationalSDLC/ClearCase/bin"
+append_to_path "/cygcrive/d/Program Files/IBM/RationalSDLC/ClearCase/bin"
+append_to_path "/cygdrive/c/Program Files (x86)/ibm/gsk8/lib"
+
+# Common CDPATHS
+CDPATH=$CDPATH:/vobs/ranccadm
elif [ "$TERM" = "cygwin" -o \
"$TERM" = "vt100" -o \
"$TERM" = "xterm" -o \
+ "$TERM" = "xtermc" -o \
"$TERM" = "xterm-256color" ]; then
- PS1="\[\e]0;$prefix$current_dir\007\]\[$RED\]$ROOT\[$LIGHT_CYAN\]$SYSNAME:\[$WHITE\]"
+ PS1="\[\e]0;$prefix$current_dir\007\]$ROOT\[$B_YELLOW\]$SYSNAME:\[$B_WHITE\]"
fi
} # title_bar
# view and a string to indicate that you are root.
function set_title {
if [ $($id -u) -eq 0 ]; then
- ROOT="Wizard "
+ root="Wizard "
else
- ROOT=
+ root=
fi
view_name=$(scm pwv -short 2> /dev/null);
if [[ $view_name = *NONE* ]]; then
view_name=""
- title_bar "$ROOT"
+ title_bar "$root"
else
- title_bar "${ROOT}View: $view_name: "
+ title_bar "${root}View: $view_name: "
fi
icon_name "${SYSNAME##*:}"
# Sets prompt on terminals listed.
function set_prompt {
if [ $($id -u) -eq 0 ]; then
- if [ "$TERM" = "hpterm" -o \
- "$TERM" = "hp" -o \
- "$TERM" = "2392A" -o \
- "$TERM" = "dtterm" -o \
- ! -z "$DTTERM" ]; then
- ROOT="${RED}Wizard$NORMAL "
- elif [ "$TERM" = "vt100" -o \
- "$TERM" = "xterm" -o \
- "$TERM" = "xterm-256color" -o \
- "$TERM" = "vt220" ]; then
- ROOT="${BOLD}${BLINK}Wizard$NORMAL "
+ if [ "$TERM" = "hpterm" -o \
+ "$TERM" = "hp" -o \
+ "$TERM" = "2392A" -o \
+ "$TERM" = "dtterm" -o \
+ "$TERM" = "vt100" -o \
+ "$TERM" = "cygwin" -o \
+ "$TERM" = "xterm" -o \
+ "$TERM" = "xtermc" -o \
+ "$TERM" = "xterm-256color" -o \
+ "$TERM" = "vt220" ]; then
+ ROOT="\[${ROOT_COLOR}\]Wizard\[$NORMAL\] "
+ else
+ ROOT="Wizard "
fi
else
ROOT=""
fi
if [ "$TERM" = "vt100" -o \
+ "$TERM" = "cygwin" -o \
"$TERM" = "xterm" -o \
+ "$TERM" = "xtermc" -o \
"$TERM" = "xterm-256color" -o \
"$TERM" = "vt220" ]; then
- PS1="$ROOT$BOLD$SYSNAME:$NORMAL"
+ PS1="$ROOT\[$B_YELLOW\]$SYSNAME:\[$B_WHITE\]"
else
PS1="$ROOT$SYSNAME:"
fi
parse_options ('windowSize=20');
-parse_options ('HistFile=.perldb.hist');
+#parse_options ('HistFile=.perldb.hist');
echo -e "${INVERSE}Inverse$NORMAL"
fi
elif [ "$TERM" = "dtterm" -o \
- "$TERM" = "xterm" ]; then
- NORMAL="$esc[39m"
- RED="$esc[31m"
- B_RED=$RED
- GREEN="$esc[32m"
- B_GREEN=$GREEN
- YELLOW="$esc[33m"
- B_YELLOW=$YELLOW
- BLUE="$esc[34m"
- B_BLUE=$BLUE
- MAGENTA="$esc[35m"
- B_MAGENTA=$MAGENTA
- AQUA="$esc[36m"
- B_AQUA=$AQUA
- WHITE="$esc[36m"
- B_WHITE=$WHITE
+ "$TERM" = "cygwin" -o \
+ "$TERM" = "xterm" -o \
+ "$TERM" = "xtermc" ]; then
+ NORMAL="$esc[0;39m"
+ RED="$esc[0;31m"
+ B_RED="$esc[1;31m"
+ GREEN="$esc[0;32m"
+ B_GREEN="$esc[1;32m"
+ YELLOW="$esc[0;33m"
+ B_YELLOW="$esc[1;33m"
+ BLUE="$esc[0;34m"
+ B_BLUE="$esc[1;34m"
+ MAGENTA="$esc[0;35m"
+ B_MAGENTA="$esc[1;35m"
+ AQUA="$esc[0;36m"
+ B_AQUA="$esc[1;36m"
+ WHITE="$esc[0;37m"
+ B_WHITE="$esc[1;37m"
+ ROOT_COLOR="$esc[1;31m"
if [ "$1" = "-v" ]; then
echo "Terminal: $TERM"
echo -e "${RED}Red$NORMAL\t${B_RED}Bright red$NORMAL"
echo -e "${GREEN}Green$NORMAL\t${B_GREEN}Bright green$NORMAL"
- echo -e "${YELLOW}Yellow$NORMAL\t${B_YELLOW}Bright green$NORMAL"
+ echo -e "${YELLOW}Yellow$NORMAL\t${B_YELLOW}Bright yellow$NORMAL"
echo -e "${BLUE}Blue$NORMAL\t${B_BLUE}Bright blue$NORMAL"
echo -e "${MAGENTA}Magenta$NORMAL\t${B_MAGENTA}Bright magenta$NORMAL"
echo -e "${AQUA}Aqua$NORMAL\t${B_AQUA}Bright aqua$NORMAL"
/usr/local/bin\
/usr/afsws/bin\
/usr/afsws\
+ /usr/xpg4/bin\
/bin\
/sbin\
/usr/bin\
/usr/openwin/bin\
/usr/kerberos/bin\
/opt/rational/clearcase/bin\
+ /opt/rational/clearquest/bin\
/opt/ibm/rationalsdlc/clearcase/bin\
/opt/ibm/rationalsdlc/clearcase/etc\
/opt/ibm/rationalsdlc/clearquest/bin\
/tools/bin\
$systemroot/System32\
$systemroot\
-"
+"
manpath_dirs="\
/usr/share/man\
/opt/ssh/man\
/opt/medusa/share/man\
/usr/afsws/man\
-"
+"
PATH=
for component in $path_dirs; do
# Aliasing
case "$SYSNAME" in
- C02s608vg8wp)
+ Az25jzhxkb2d)
SYSNAME="Venus"
;;
esac
--- /dev/null
+################################################################################
+#
+# File: testclearcase.conf
+# Revision: 2.0
+# Description: Parameters for testclearcse.pl
+#
+# Author: Andrew@DeFaria.com
+# Created: Thu Sep 6 14:05:55 MST 2007
+# Modified:
+# Language: Conf
+#
+# (c) Copyright 2007, Andrew@DeFaria.com, all rights reserved.
+#
+#################################################################################
+# Note this conf file is set up for Windows...
+vobhost: az251dp2ch2d
+vobpath: //$vobhost
+vobstore: $vobpath/temp
+
+viewhost: az251dp2ch2d
+viewpath: //$vobhost
+viewdrive: x:
+viewstore: $viewpath/viewstore
-#!/usr/bin/perl
+#!/usr/bin/env cqperl
+
+=pod
+
+=head1 NAME $RCSfile: testclearcase.pl,v $
+
+Test Clearcase
+
+=head1 VERSION
+
+=over
+
+=item Author
+
+Andrew DeFaria <Andrew@ClearSCM.com>
+
+=item Revision
+
+$Revision: 2.1 $
+
+=item Created:
+
+Tue Apr 10 13:14:15 CDT 2007
+
+=item Modified:
+
+$Date: 2011/01/09 01:01:32 $
+
+=back
+
+=head1 SYNOPSIS
+
+ Usage: testclearcase.pl: [-us|age] [-ve|rbose]
+ [-c|onfig <file>] [-b|ase] [-uc|m]
+
+ Where:
+ -v|erbose: Display progress output
+ -d|ebug: Display debug info
+ -us|age: Display usage
+
+ -c|onfig <file>: Config file (Default: testclearcase.conf)
+ -[no]b|ase: Perform base Clearcase tests (Default: base)
+ -[no]uc|m: Perform UCM Clearcase tests (Default: noucm)
+ -[no]clean: Cleanup after yourself (Default: clean)
+
+if -ucm is specified then the following additional parameters should be set:
+
+ -username: Username to connect to Clearquest with (Can set CQ_USERNAME)
+ -password: Password to use to connect to Clearquest (CQ_PASSWORD)
+ -weburl: Web URL to use for enabling Clearcase -> Clearquest
+ connection (CQ_WEBURL - Do not specify the trailing
+ "/oslc")
+ -database: Clearquest database to enable (CQ_DATABASE)
+ -dbset: Clearquest DBSet (CQ_DBSET)
+ -provider: Name of provider (Default: CQPROV)
+
+=head1 DESCRIPTION
+
+Clearcase smoke tests. Perform simple Clearcase operations to validate that
+Clearcase minimally works.
+
+If -ucm is specified then additional UCM related tests are performed.
+
+=cut
+
use strict;
use warnings;
+use Cwd;
use FindBin;
-use Term::ANSIColor qw(:constants);
+use Getopt::Long;
+use Pod::Usage;
-my $libs;
+use lib "$FindBin::Bin/../lib";
-BEGIN {
- $libs = $ENV{SITE_PERLLIB} ? $ENV{SITE_PERLLIB} : "$FindBin::Bin/../lib";
-
- die "Unable to find libraries\n"
- unless -d $libs;
-} # BEGIN
+use Clearcase;
+use Clearcase::Element;
+use Clearcase::View;
+use Clearcase::Views;
+use Clearcase::Vob;
+use Clearcase::Vobs;
-use lib $libs;
+use Clearcase::UCM;
+use Clearcase::UCM::Activity;
+use Clearcase::UCM::Baseline;
+use Clearcase::UCM::Component;
+use Clearcase::UCM::Folder;
+use Clearcase::UCM::Project;
+use Clearcase::UCM::Pvob;
+use Clearcase::UCM::Stream;
-use Clearcase;
+use DateUtils;
use Display;
+use GetConfig;
+use Logger;
+use OSDep;
+use TimeUtils;
+use Utils;
+
+# Globals
+my $VERSION = '2.1';
+
+my (
+ $test_vob,
+ $test_view,
+ $test_pvob,
+ $test_folder,
+ $test_project,
+ $test_activity,
+ $test_baseline,
+ $test_component,,
+ $test_devstream,
+ $test_intstream,
+ $test_devview,
+ $test_intview,
+);
+
+my (%default_opts, %opts);
+
+my ($script) = ($FindBin::Script =~ /^(.*)\.pl/);
+
+my $log = Logger->new;
+
+# LogOpts: Log the %opts has to the log file so we can tell the options used for
+# this run.
+sub LogOpts() {
+ $log->msg(
+ "$script v$VERSION run at "
+ . YMDHM
+ . ' with the following options:'
+ );
+
+ for (sort keys %opts) {
+ next if /help/ || /usage/ || /password/;
+
+ if (ref $opts{$_} eq 'ARRAY') {
+ my $name = $_;
+
+ for (@{$opts{$_}}) {
+ $log->msg("$name:\t$_") if $_;
+ } # for
+ } else {
+ if ($opts{$_}) {
+ $log->msg("$_:\t$opts{$_}");
+ } else {
+ $log->msg("$_:\t<undef>");
+ } # if
+ } # if
+ } # for
+
+ return;
+} # LogOpts
+
+sub CreateVob($) {
+ my ($tag) = @_;
+
+ my $vobname = Clearcase::vobname $tag;
+
+ $log->msg ("Creating vob $tag");
+
+ my $newvob = Clearcase::Vob->new($tag);
+
+ my ($status, @output) = $newvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs");
+
+ $log->log($_) for @output;
+
+ return ($status, $newvob);
+} # CreateVob
+
+sub CreatePvob($) {
+ my ($tag) = @_;
+
+ my $vobname = Clearcase::vobname $tag;
+
+ my $pvob = Clearcase::UCM::Pvob->new($tag);
+
+ #my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs", 'A test Pvob');
+ my ($status, @output) = $pvob->create($opts{vobhost}, "$opts{vobstore}/$vobname.vbs");
+
+ $log->log($_) for @output;
+
+ return ($status, $pvob);
+} # CreatePvob
+
+sub MountVob($) {
+ my ($vob) = @_;
+
+ $log->msg('Mounting vob ' . $vob->tag);
+
+ # Create mount directory
+ my ($status, @output);
+
+ ($status, @output) = Execute 'mkdir -p ' . $vob->tag . ' 2>&1' unless -d $vob->tag;
+
+ $log->log($_) for @output;
+
+ ($status, @output) = $vob->mount;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # MountVob
+
+sub DestroyVob($) {
+ my ($vob) = @_;
+
+ my ($status, @output);
+
+ ($status, @output) = $Clearcase::CC->execute('cd');
+
+ $log->err('Unable to perform cd command', 1) if $status;
+
+ $log->msg('Unmounting vob ' . $vob->tag);
+
+ ($status, @output) = $vob->umount;
+
+ if ($status) {
+ $log->err('Unable to unmount vob ' . $vob->tag);
+ } else {
+ $log->msg('Umounted vob ' . $vob->tag);
+ } # if
+
+ $log->msg('Removing vob ' . $vob->tag);
+
+ ($status, @output) = $vob->remove;
+
+ if ($status) {
+ $log->err("Failed to execute command " .
+ $Clearcase::CC->lastcmd . "\n" .
+ join "\t\n", @output);
+ } # if
+
+ $log->log($_) for @output;
+
+ return $status;
+} # DestroyVob
+
+sub CreateView($) {
+ my ($tag) = @_;
+
+ $log->msg("Creating view $tag");
+
+ my $view = Clearcase::View->new($tag);
+
+ my ($status, @output) = $view->create($opts{viewhost}, "$opts{viewstore}/$tag.vws");
+
+ $log->log($_) for @output;
+
+ return ($status, $view);
+} # CreateView
+
+sub SetView($) {
+ my ($view) = @_;
+
+ $log->msg('Setting view ' . $view->tag);
+
+ my ($status, @output) = $view->set;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # SetView
+
+sub StopView($) {
+ my ($view) = @_;
+
+ $log->msg('Stopping view ' . $view->tag);
+
+ my ($status, @output) = $view->stop;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # StopView
+
+sub DestroyView($) {
+ my ($view) = @_;
+
+ $log->msg('Removing view ' . $view->tag);
+
+ my ($status, @output) = $Clearcase::CC->execute('cd');
+
+ $log->log($_) for @output;
+
+ chdir $ENV{HOME}
+ or $log->err("Unable to chdir $ENV{HOME}", 1);
+
+ ($status, @output) = $view->remove;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # DestroyView
+
+sub CreateViewPrivateFiles(@) {
+ my (@elements) = @_;
+
+ $log->msg('Creating test files');
+
+ for (@elements) {
+ my $file;
+
+ $log->msg("Creating $_");
+
+ open $file, '>>', $_
+ or $log->err("Unable to open $_ for writing - $!", 1);
+
+ print $file "This is file $_\n";
+
+ close $file;
+ } # for
+
+ return;
+} # CreateViewPrivateFiles
+
+sub CheckOut($) {
+ my ($element) = @_;
+
+ my ($status, @output);
+
+ if (ref $element eq 'ARRAY') {
+ for (@{$element}) {
+ $log->msg("Checking out $_");
+
+ my $newElement = Clearcase::Element->new($_);
+
+ ($status, @output) = $newElement->checkout;
+
+ $log->log($_) for @output;
+
+ $log->err("Unable to check out $_", $status) if $status;
+ } # for
+ } else {
+ $log->msg("Checking out $element");
+
+ my $newElement = Clearcase::Element->new($element);
+
+ ($status, @output) = $newElement->checkout;
+
+ $log->log($_) for @output;
+
+ $log->err("Unable to check out $element", $status) if $status;
+ } # if
+
+ return;
+} # CheckOut
+
+sub CheckIn($) {
+ my ($element) = @_;
+
+ my ($status, @output);
+
+ if (ref $element eq 'ARRAY') {
+ for (@{$element}) {
+ $log->msg("Checking in $_");
+
+ my $newElement = Clearcase::Element->new($_);
+
+ ($status, @output) = $newElement->checkin;
+
+ $log->log($_) for @output;
+
+ $log->err("Unable to check in $_", $status) if $status;
+ } # for
+ } else {
+ $log->msg("Checking in $element");
+
+ my $newElement = Clearcase::Element->new($element);
+
+ ($status, @output) = $newElement->checkin;
+
+ $log->log($_) for @output;
+
+ $log->err("Unable to check in $element", $status) if $status;
+ } # if
+
+ return;
+} # CheckIn
+
+sub ComparingFiles(@) {
+ my (@elements) = @_;
+
+ for (@elements) {
+ my @lines = ReadFile $_;
+
+ $log->err("Element $_ should contain only two lines", 2) if scalar @lines != 2;
+ } # for
+
+ return;
+} # ComparingFiles
+
+sub MakeElements(@) {
+ my (@elements) = @_;
+
+ for (@elements) {
+ $log->msg("Mkelem $_");
+
+ my $newElement = Clearcase::Element->new($_);
+
+ my ($status, @output) = $newElement->mkelem;
+
+ $log->log($_) for @output;
+
+ $log->err("Unable to make $_ an element", $status) if $status;
+ } # for
+
+ return;
+} # MakeElements
+
+sub RunTests() {
+ # Simple tests:
+ #
+ # . Create a few elements
+ # . Check them in
+ # . Check them out
+ # . Modify them
+ # . Check them in
+ #
+ # Assumptions:
+ #
+ # . $vob_tag is already created
+ # . $view_tag is already created
+ # . View is set and we are in the vob
+ # . There are no vob elements for @elements
+ my @elements = (
+ 'cctest.h',
+ 'ccsetup.c',
+ 'cctest.c',
+ 'Makefile',
+ );
+
+ $log->msg("$script: Start Base Clearcase Tests");
+ $log->msg('Removing test files');
+
+ unlink $_ for @elements;
+
+ $log->msg('Creating view private files');
+
+ CreateViewPrivateFiles @elements;
+
+ $log->msg('Making elements');
+
+ CheckOut '.';
+ MakeElements @elements;
+ CheckIn \@elements;
+ CheckIn '.';
+
+ $log->msg('Checking out files');
+
+ CheckOut \@elements;
+
+ $log->msg('Modifying files');
+
+ CreateViewPrivateFiles @elements;
+
+ $log->msg('Checking in files');
+
+ CheckIn \@elements;
+
+ $log->msg('Comparing files');
+
+ ComparingFiles @elements;
+
+ $log->msg("$script: End Base Clearcase Tests");
+
+ return 0;
+} # RunTests
+
+sub Cleanup(;$$$) {
+ my ($view, $vob) = @_;
+
+ my $status = 0;
+
+ $log->msg('Cleaning up');
+
+ if ($view && $view->exists) {
+ $status += DestroyView($view);
+ } # if
+
+ if ($vob && $vob->exists) {
+ $status += DestroyVob($vob);
+ } # if
+
+ return $status;
+} # Cleanup
+
+sub CleanupUCM() {
+ my ($rc, $status, @output);
+
+ $log->msg('Removing ' . $test_activity->name);
+
+ ($rc, @output) = $test_activity->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ # Need to remove baselines from streams first using rebase (Devstream)
+ $log->msg('Rebasing ' . $test_devstream->name . ' to remove baseline');
+
+ $status += RebaseStream(
+ $test_devstream,
+ ' -dbaseline ' . $test_baseline->name . '@' . $test_baseline->pvob->tag .
+ ' -view ' . $test_devview->name . ' -complete',
+ );
+
+ # Change intstream to not have a recommended baseline
+ $log->msg('Changing ' . $test_intstream->name . ' to remove recommended baseline');
+
+ ($rc, @output) = $test_intstream->nrecommended;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $status += DestroyView($test_devview);
+
+ $log->msg('Removing ' . $test_baseline->name);
+
+ ($rc, @output) = $test_baseline->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Rebasing ' . $test_intstream->name . ' to remove INITIAL baseline');
+
+ $status += RebaseStream(
+ $test_intstream,
+ ' -dbaseline tc.component_INITIAL' . '@' . $test_intstream->pvob->tag .
+ ' -view ' . $test_intview->name . ' -complete',
+ );
+
+ $log->msg('Removing ' . $test_component->name . ' from ' . $test_project->name);
+
+ ($rc, @output) = $test_project->change(
+ '-dmodcomp ' . $test_component->name . '@' . $test_project->pvob->tag
+ );
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_component->name);
+
+ ($rc, @output) = $test_component->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $status += DestroyView($test_intview);
+
+ $log->msg('Removing '. $test_devstream->name);
+
+ ($rc, @output) = $test_devstream->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_intstream->name);
+
+ ($rc, @output) = $test_intstream->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_project->name);
+
+ ($rc, @output) = $test_project->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_folder->name);
+
+ ($rc, @output) = $test_folder->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ $log->msg('Removing ' . $test_pvob->name);
+
+ ($rc, @output) = DestroyVob($test_pvob);
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CleanupUCM
+
+sub SetupTest($$) {
+ my ($vob_tag, $view_tag) = @_;
+
+ my ($status, @output);
+
+ $log->msg('Setup test environment');
+
+ my $view = Clearcase::View->new($view_tag);
+
+ if ($view->exists) {
+ $log->msg('Removing old view ' . $view_tag);
+
+ ($status, @output) = $view->remove;
+
+ $log->err('Unable to remove old view ' . $view->tag, $status) if $status;
+ } # if
+
+ ($status, $test_view) = CreateView($view_tag);
+
+ return $status if $status != 0;
+
+ $status = $test_view->start;
+
+ my $vob = Clearcase::Vob->new($vob_tag);
+
+ if ($vob->exists) {
+ $log->msg('Removing old vob ' . $vob_tag);
+
+ ($status, @output) = DestroyVob($vob);
+
+ $log->err('Unable to remove old vob '. $vob->tag, $status) if $status;
+ } # if
+
+ ($status, $test_vob) = CreateVob($vob_tag);
+
+ return $status if $status != 0;
+
+ $status = MountVob($test_vob);
+
+ return $status if $status != 0;
+
+ my $dir = $Clearcase::VIEWTAG_PREFIX . '/' . $test_view->tag . $test_vob->tag;
+
+ chdir $dir
+ or $log->err("Unable to chdir to $dir", ++$status);
+
+ ($status, @output) = $Clearcase::CC->execute("cd $dir");
+
+ $log->log($_) for @output;
+
+ return $status;
+} # SetupTest
+
+sub SetupAttributeTypes() {
+ my @CC_CMI_Types = qw(CONTEXT TASK PROVIDERS);
+
+ my $status = SetView($test_intview);
+
+ return $status if $status;
+
+ for (@CC_CMI_Types) {
+ my $cmd = "mkattype -nc -vtype string CC_CMI_$_";
+
+ my ($rc, @output) = $Clearcase::CC->execute($cmd);
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+ } # for
+
+ return $status;
+} # SetupAttributeTypes
+
+sub CRMRegister() {
+ my $cmd = "crmregister add -database $opts{database} -connection RDE "
+ . "-url $opts{weburl} -username $opts{username} "
+ . "-password $opts{password}";
+
+ my ($status, @output) = Execute $cmd;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CRMRegister
+
+sub MakeCMProvider() {
+ my $cmd = 'mkcmprovider -vob ' . $test_pvob->tag
+ . '-type cmcq -version V1_0 -description '
+ . '"RDE CMI CQ Provider" '
+ . '-connection baseurl:' . $opts{weburl} . " $opts{provider}";
+
+ my ($status, @output) = $Clearcase::CC->execute($cmd);
+
+ $log->log($_) for @output;
+
+ return $status;
+} # MakeCMProvider
+
+sub SetupUCMTest() {
+ my $status;
+
+ $log->msg("Register RDE://$opts{username}\@$opts{database}");
+
+ $status = CRMRegister;
+
+ $log->err("Unable to register RDE://$opts{username}\@$opts{database} - Check logfile", $status)
+ if $status;
+
+ $log->msg("Creating UCM Pvob ${Clearcase::VOBTAG_PREFIX}tc.pvob");
+
+ ($status, $test_pvob) = CreatePvob("${Clearcase::VOBTAG_PREFIX}tc.pvob");
+
+ MountVob $test_pvob;
+
+ return $status;
+} # SetupUCMTest
+
+sub CreateUCMProject() {
+ # Get the root folder to put this project into (may create folders later)
+ $test_folder = Clearcase::UCM::Folder->new('tc.folder', $test_pvob);
+
+ $test_project = Clearcase::UCM::Project->new('tc.project', $test_folder, $test_pvob);
+
+ $test_project->remove if $test_project->exists;
+
+ $log->msg('Creating UCM Project tc.project');
+
+ my ($status, @output) = $test_project->create;
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMProject
+
+sub CreateUCMIntStream() {
+ $test_intstream = Clearcase::UCM::Stream->new('tc.intstream', $test_pvob);
+
+ $log->msg('Creating UCM Stream tc.intstream');
+
+ my ($status, @output) = $test_intstream->create($test_project, '-integration');
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMIntStream
+
+sub CreateUCMDevStream() {
+ $test_devstream = Clearcase::UCM::Stream->new('tc.devstream', $test_pvob);
+
+ $log->msg('Creating UCM Stream tc.devstream');
+
+ my ($status, @output) = $test_devstream->create($test_project);
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMDevStream
+
+sub CreateUCMComponent() {
+ $test_component = Clearcase::UCM::Component->new('tc.component', $test_pvob);
+
+ $log->msg('Creating UCM Component tc.component');
+
+ my ($status, @output) = $test_component->create(
+ "$Clearcase::VIEWTAG_PREFIX/" . $test_intview->tag . $test_vob->tag
+ );
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMComponent
+
+sub AddModifiableComponent() {
+ my ($status, @output) = $Clearcase::CC->execute(
+ 'chproj -nc -amodcomp ' . $test_component->name . '@' . $test_pvob->tag .
+ ' ' . $test_project->name . '@' . $test_pvob->tag
+ );
+
+ $log->log($_) for @output;
+
+ return $status;
+} # AddModifiableCOmponent
+
+sub CreateUCMIntView() {
+ $log->msg("Creating UCM Int View tc.intview");
+
+ $test_intview = Clearcase::View->new('tc.intview');
+
+ my ($status, @output) = $test_intview->create(
+ $opts{viewhost}, "$opts{viewstore}/tc.intview.vws",
+ '-stream ' . $test_intstream->name . '@' . $test_pvob->tag
+ );
+
+ $log->log($_) for @output;
+
+ $test_intview->start unless $status;
+
+ return $status;
+} # CreateUCMIntView
+
+sub CreateUCMDevView() {
+ $log->msg("Creating UCM Dev View tc.devview");
+
+ $test_devview = Clearcase::View->new('tc.devview');
+
+ my ($status, @output) = $test_devview->create(
+ $opts{viewhost}, "$opts{viewstore}/tc.devview.vws",
+ '-stream ' . $test_devstream->name . '@' . $test_pvob->tag
+ );
+
+ $log->log($_) for @output;
+
+ $test_devview->start unless $status;
+
+ return $status;
+} # CreateUCMDevView
+
+sub CreateUCMBaseline() {
+ $test_baseline = Clearcase::UCM::Baseline->new('tc.baseline', $test_pvob);
+
+ $log->msg('Creating UCM Baseline tc.baseline');
+
+ my ($status, @output) = $test_baseline->create($test_intview, undef, '-identical');
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMBaseline
+
+sub CreateUCMActivity() {
+ $test_activity = Clearcase::UCM::Activity->new('tc.activity', $test_pvob);
+
+ $log->msg('Creating UCM Activity tc.activity');
+
+ my ($status, @output) = $test_activity->create($test_devstream, 'A UCM Test Activity');
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateUCMActivity
+
+sub RebaseStream($$) {
+ my ($stream, $opts) = @_;
+
+ my ($status, @output) = $stream->rebase($opts);
+
+ $log->log($_) for @output;
+
+ return $status;
+} # RebaseStream
+
+sub RecommendBaseline($$) {
+ my ($stream, $baseline) = @_;
+
+ my ($status, @output) = $stream->recommend($baseline);
+
+ $log->log($_) for @output;
+
+ return $status;
+} # RecommentBaseline
+
+sub RunUCMTests() {
+ my $status = 0;
+
+ $log->msg("$script: Start UCM Clearcase Tests");
+
+ $status += CreateUCMProject;
+ $status += CreateUCMIntStream;
+ $status += CreateUCMDevStream;
+ $status += CreateUCMIntView;
+ $status += SetupAttributeTypes;
+ $status += CreateUCMDevView;
+ $status += CreateUCMComponent;
+ $status += AddModifiableComponent;
+ $status += RebaseStream($test_intstream, '-baseline tc.component_INITIAL -complete');
+ $status += RecommendBaseline($test_intstream, 'tc.component_INITIAL');
+ $status += CreateUCMBaseline;
+ $status += RebaseStream($test_devstream, '-baseline tc.baseline -complete');
+ $status += RecommendBaseline($test_devstream, 'tc.baseline');
+ $status += CreateUCMActivity;
+
+ $log->msg("$script: End UCM Clearcase Tests");
+
+ return $status;
+} # RunUCMTests
+
+## Main
+my $startTime = time;
+my $conf_file = "$FindBin::Bin/$script.conf";
+my $status = 0;
+
+$opts{help} = sub { pod2usage };
+$opts{usage} = sub { pod2usage (-verbose => 2)};
+$opts{base} = 1;
+$opts{clean} = 1;
+$opts{username} = $ENV{CQ_USERNAME};
+$opts{password} = $ENV{CQ_PASSWORD};
+$opts{weburl} = $ENV{CQ_WEBURL};
+
+$opts{weburl} .= $opts{weburl} ? "/oslc" : undef;
+$opts{database} = $ENV{CQ_DATABASE};
+$opts{dbset} = $ENV{CQ_DBSET};
+$opts{provider} = $ENV{CQ_PROVIDER} || 'CQPROV';
+
+GetOptions(
+ \%opts,
+ 'verbose' => sub { set_verbose },
+ 'debug' => sub { set_debug },
+ 'usage' => sub { Usage },
+ 'config=s',
+ 'base!',
+ 'ucm!',
+ 'clean!',
+ 'username=s',
+ 'database=s',
+ 'dbset=s',
+ 'provider',
+) || pod2usage;
+
+# Read the config file
+if (-f $conf_file) {
+ %default_opts = GetConfig $conf_file;
+} else {
+ $log->err("Unable to find config file $conf_file", 1);
+} # if
+
+# Overlay default opts if not specified
+for (keys %default_opts) {
+ $opts{$_} = $default_opts{$_} if !$opts{$_};
+} # for
+
+# Check CQ parameters
+if ($opts{ucm}) {
+ for ('username', 'password', 'weburl', 'database', 'dbset', 'provider') {
+ pod2usage "In UCM mode you must specify -$_" unless $opts{$_};
+ } # for
+} # if
+
+$log->msg("$script: Start");
+
+LogOpts;
+
+# Since we are creating private vobs (to avoid complications with having to
+# know and code the registry password when making public vobs), we'll simply
+# change $Clearcase::VOBTAG_PREFIX
+if ($ARCHITECTURE !~ /win/i) {
+ $Clearcase::VOBTAG_PREFIX = $ENV{TMP} . '/' || '/tmp';
+} # if
+
+if ($opts{base}) {
+ $status = SetupTest "${Clearcase::VOBTAG_PREFIX}tc.vob", 'tc.view';
+
+ if ($status == 0) {
+ $status += RunTests;
+ } else {
+ $log->err('Tests not run. Failure occurred in SetupTest - check logfile');
+ } # if
+
+ # Note if we are doing UCM tests then we need the view and vob here...
+ $status += Cleanup($test_view, $test_vob) if $opts{clean} && !$opts{ucm};
+
+ if ($status != 0) {
+ $log->err("$script: Failed (Base Clearcase)");
+ } else {
+ $log->msg("$script: Passed (Base Clearcase)");
+ } # if
+} # if
+
+if ($opts{ucm}) {
+ $status = SetupUCMTest;
+
+ if ($status == 0) {
+ $status += RunUCMTests;
+ } else {
+ $log->err('UCM Tests not run. Failure occurred in SetupUCMTest - check logfile');
+ } # if
+
+ if ($opts{clean}) {
+ $status += CleanupUCM;
+ $status += Cleanup($test_view, $test_vob);
+ } # if
+
+ if ($status != 0) {
+ $log->err("$script: Failed (UCM Clearcase)");
+ } else {
+ $log->msg("$script: Passed (UCM Clearcase)");
+ } # if
+} # if
+
+display_duration $startTime, $log;
+
+$log->msg("$script: End");
+
+exit $status;
+
+=pod
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+DEBUG: If set then $debug is set to this level.
+
+VERBOSE: If set then $verbose is set to this level.
+
+TRACE: If set then $trace is set to this level.
+
+=head1 DEPENDENCIES
+
+=head2 Perl Modules
+
+L<Cwd>
-my ($status, @output) = $Clearcase::CC->execute ('-ver');
+L<FindBin>
-error 'Clearcase is not installed on this system', 1
- if $status;
-
-display YELLOW . "Global Clearcase Variables\n" . RESET;
+L<Getopt::Long|Getopt::Long>
-my $view_drive = $Clearcase::VIEW_DRIVE;
-my $vob_mount = $Clearcase::VOB_MOUNT;
-my $win_vob_prefix = $Clearcase::WIN_VOB_PREFIX;
-my $vobtag_prefix = $Clearcase::VOBTAG_PREFIX;
-my $countdb = $Clearcase::COUNTDB;
+=head2 ClearSCM Perl Modules
-display MAGENTA . "View Drive:\t\t" . RESET . $view_drive;
-display MAGENTA . "VOB Mount:\t\t" . RESET . $vob_mount;
-display MAGENTA . "Windows VOB prefix:\t" . RESET . $win_vob_prefix;
-display MAGENTA . "VOB Tag Prefix:\t\t" . RESET . $vobtag_prefix;
-display MAGENTA . "CountDB:\t\t" . RESET . $countdb;
+=begin man
-display CYAN . "\nGlobal Clearcase Configuration\n" . RESET;
+ Clearcase
+ Clearcase::Element
+ Clearcase::View
+ Clearcase::Views
+ Clearcase::Vob
+ Clearcase::Vobs
+ DateUtils
+ Display
+ GetConfig
+ Logger
+ OSDep
+ Utils
-display MAGENTA . "Client:\t\t\t" . RESET . $Clearcase::CC->client;
-display MAGENTA . "Hardware type:\t\t" . RESET . $Clearcase::CC->hardware_type;
-display MAGENTA . "License host:\t\t" . RESET . $Clearcase::CC->license_host;
-display MAGENTA . "OS:\t\t\t" . RESET . $Clearcase::CC->os;
-display MAGENTA . "Region:\t\t\t" . RESET . $Clearcase::CC->region;
-display MAGENTA . "Registry host:\t\t" . RESET . $Clearcase::CC->registry_host;
-display MAGENTA . "Sitename:\t\t" . RESET . $Clearcase::CC->sitename;
-display MAGENTA . "Version:\t\t" . RESET . $Clearcase::CC->version;
+=end man
-display GREEN . "\nCleartool Access\n" . RESET;
+=begin html
-display_nolf MAGENTA . "Views:\t" . RESET;
+<blockquote>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Element.pm">Element</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/View.pm">View</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Views.pm">Views</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vob.pm">Vob</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/Vobs.pm">Vobs</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM.pm">UCM</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Activity.pm">Activity</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Baseline.pm">Baseline</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Component.pm">Component</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Project.pm">Project</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Pvob.pm">Pvob</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Clearcase/UCM/Stream.pm">Stream</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Logger.pm">Logger</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/OSDep.pm">OSDep</a><br>
+<a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
+</blockquote>
-($status, @output) = $Clearcase::CC->execute ("lsview -s");
+=end html
-display scalar @output;
+=head1 BUGS AND LIMITATIONS
-display_nolf MAGENTA . "VOBs:\t" . RESET;
+There are no known bugs in this script
-($status, @output) = $Clearcase::CC->execute ("lsvob -s");
+Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
-display scalar @output;
+=head1 LICENSE AND COPYRIGHT
-($status, @output) = $Clearcase::CC->execute ("invalid command");
+Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
-display $_ foreach (@output);
+=cut
-#!/usr/bin/perl
+#!/usr/bin/env cqperl
use strict;
use warnings;
=head1 SYNOPSIS
Usage: testclearquest.pl [-u|sage] [-v|erbose] [-d|ebug]
- [-get] [-add] [-modify] [-change] [-delete]
+ [-get] [-add] [-modify] [-change] [-delete]
[-username <username>] [-password <password>]
[-database <dbname>] [-dbset <dbset>]
[-module] [-server <server>] [-port <port>]
-
+
Where:
-usa|ge: Displays usage
-v|erbose: Be verbose
-change: Test change
-delete: Test delete
- -use|rname: Username to open database with (Default: from config file)
- -p|assword: Password to open database with (Default: from config file)
- -da|tabase: Database to open (Default: from config file)
- -db|set: Database Set to use (Default: from config file)
- -m|odule: Type of Clearquest module to use. Must be one of 'api',
- 'client', or 'rest'. The 'api' module can only be used if
- Clearquest is installed locally. The 'client' module can only
- be successful if a corresponding server is running. And the
- 'rest' module can only be used if a CQ Web server has been set
- up and configured (Default: rest)
- -s|erver: For module = client or rest this is the name of the server that
- will be providing the service
- -p|ort: For module = client, this is the point on the server to talk
- through.
+ -use|rname: Username to open database with (Default: CQ_USERNAME or from
+ config file)
+ -p|assword: Password to open database with (Default: CQ_PASSWORD or from
+ config file)
+ -da|tabase: Database to open (Default: CQ_DATABASE or from config file)
+ -db|set: Database Set to use (Default: CQ_DBSET or from config file)
+
=head1 Options
use FindBin;
use Getopt::Long;
+use Pod::Usage;
use lib "$FindBin::Bin/../lib";
use Clearquest;
+use Clearcase::View;
+use Clearcase::UCM::Activity;
+use Clearcase::UCM::Stream;
+use Clearcase::UCM::Project;
+use Clearcase::UCM::Pvob;
+use DateUtils;
use Display;
+use Logger;
+use OSDep;
use TimeUtils;
use Utils;
-my ($cq, %opts);
+my ($cq, %opts, $log, $createView, $test_pvob, $test_project);
-sub displayRecord (%) {
+my $status = 0;
+my $project = 'tc.project';
+
+sub displayRecord(%) {
my (%record) = @_;
-
- display '-' x 79;
-
- foreach (keys %record) {
- display_nolf "$_: ";
-
+
+ $log->msg('-' x 79);
+
+ for (keys %record) {
+ $log->msg("$_: ", 1);
+
if (ref $record{$_} eq 'ARRAY') {
- display join ", ", @{$record{$_}};
+ $log->msg(join ", ", @{$record{$_}});
} elsif ($record{$_}) {
- display $record{$_};
+ $log->msg($record{$_});
} else {
- display "<undef>";
+ $log->msg('<undef>');
} # if
- } # foreach
-
+ } # for
+
return;
} # displayRecord
-sub displayResults (@) {
+sub displayResults(@) {
my (@records) = @_;
-
+
if (@records) {
displayRecord %$_ foreach (@records);
} else {
- display "Did not find any records";
+ $log->msg('Did not find any records');
} # if
-
+
return;
} # displayResults
-sub testGetRecord ($$;@) {
+sub GetRecord($$;@) {
my ($table, $key, @fields) = @_;
-
- my $startTime = time;
-
- display "Testing get table: $table key: $key";
-
- displayRecord $cq->get ($table, $key, @fields);
-
- display_duration $startTime;
-
- return;
-} # testGetRecord
-sub testFindRecord ($$;@) {
- my ($table, $condition, @fields) = @_;
-
- my $startTime = time;
-
- display "Testing find table: $table condition: $condition";
-
- my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
+ $log->msg("Gettng table: $table key: $key");
- display "$nbrRecs records qualified";
+ my %record = $cq->get($table, $key, @fields);
- while (my %record = $cq->getNext ($result)) {
+ if ($cq->checkErr) {
+ $log->err($cq->errmsg);
+ } else {
displayRecord %record;
+ } # if
+
+ return $cq->error;
+} # GetRecord
+
+sub FindRecord($$;@) {
+ my ($table, $condition, @fields) = @_;
+
+ my $status;
+
+ $log->msg("Finding table: $table condition: $condition");
+
+ my ($result, $nbrRecs) = $cq->find($table, $condition, @fields);
+
+ $log->msg("$nbrRecs records qualified");
+
+ while (my %record = $cq->getNext($result)) {
+ unless ($cq->error) {
+ # Store away the createView.pl script location
+ $createView = $record{ws_cr_view} if $table eq 'Platform_Options';
+
+ displayRecord %record;
+
+ $status += $cq->error;
+ } # unless
} # while
-
- display_duration $startTime;
-
- return;
-} # testFindRecord
-sub testModifyRecord ($$;%) {
+ return $status
+} # FindRecord
+
+sub ModifyRecord($$;%) {
my ($table, $key, %update) = @_;
-
- my $startTime = time;
-
- display "Testing modify table: $table key: $key";
-
- $cq->modify ($table, $key, undef, \%update);
-
- $cq->checkErr;
-
- display_duration $startTime;
-
- return;
-} # testModifyRecord
-sub testChangeState ($$) {
- my ($table, $key) = @_;
-
- my $startTime = time;
-
- my %record = $cq->get ($table, $key, ('State'));
-
- $cq->checkErr ("Unable to find $table where key = $key");
-
- return if $cq->error;
+ $log->msg("Modifying table: $table key: $key");
+
+ $cq->modify($table, $key, undef, \%update);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # ModifyRecord
+
+sub AssignWOR($) {
+ my ($key) = @_;
+
+ my %record = $cq->get('WOR', $key, ('State'));
+
+ return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
+
+ my ($action, %update);
+
+ if ($record{State} ne 'Submitted') {
+ $log->err("Cannot assign $key - not in submitted state");
+
+ return 1;
+ } # if
+
+ $action = 'Assign';
+ $update{PlannedStart} = Today2SQLDatetime;
+ $update{ucm_project} = $project;
+
+ $log->msg("Testing change WOR state of $key action: $action");
+
+ $cq->modify('WOR', $key, $action, \%update);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # AssignWOR
+
+sub ActivateWOR($) {
+ my ($key) = @_;
+
+ my %record = $cq->get('WOR', $key, ('State'));
+
+ return $cq->error if $cq->checkErr("Unable to find WOR where key = $key");
my ($action, %update);
-
- if ($record{State} eq 'Assigned') {
- $action = 'AdminAssignToSubmit';
- $update{Stability_Issue} = 'User Fault';
+
+ if ($record{State} ne 'Assessing') {
+ $log->err("Cannot activate $key - not in Assessing state");
+
+ return 1;
+ } # if
+
+ $action = 'Activate';
+
+ $log->msg("Testing change WOR state of $key action: $action");
+
+ $cq->modify('WOR', $key, $action);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # ActivateWOR
+
+sub AddRecord($$;$$) {
+ my ($table, $record, $ordering, $returnField) = @_;
+
+ $returnField ||= 'id';
+
+ $log->msg("Adding table: $table");
+
+ my $dbid = $cq->add($table, $record, @$ordering);
+
+ if ($cq->checkErr) {
+ $log->err($cq->errmsg);
+
+ return;
} else {
- $action = 'Assign';
- $update{Stability_Issue} = 'Assert';
+ my %record = $cq->getDBID($table, $dbid, ($returnField));
+
+ return $record{$returnField};
} # if
-
- display "Testing change state table: $table key: $key action: $action";
-
- $cq->modify ($table, $key, $action, \%update);
-
- $cq->checkErr;
-
- display_duration $startTime;
-
- return;
-} # testChangeState
-
-sub testAddRecord ($%) {
- my ($table, %record) = @_;
-
- my $startTime = time;
-
- display "Testing adding table: $table";
-
- $cq->add ($table, \%record, qw(Projects VersionStr));
-
- $cq->checkErr;
-
- display_duration $startTime;
-
- return;
-} # testAddRecord
+} # AddRecord
-sub testDeleteRecord ($$) {
+sub DeleteRecord($$) {
my ($table, $key) = @_;
-
- my $startTime = time;
-
- display "Testing deleting table: $table key: $key";
-
- $cq->delete ($table, $key);
-
- $cq->checkErr;
-
- display_duration $startTime;
-
- return;
-} # testDeleteRecord
+
+ $log->msg("Deleting table: $table key: $key");
+
+ $cq->delete($table, $key);
+
+ $log->err($cq->errmsg) if $cq->checkErr;
+
+ return $cq->error;
+} # DeleteRecord
+
+sub CreateWOR() {
+ # Try to add a WOR - the following fields are required and some may need
+ # to be added to stateless records in order for this to succeed. Once you
+ # can add a WOR through the Clearquest client successfully you should be
+ # able to come up with the values of these required fields. There are,
+ # however, sometimes when you need to specify ordering to have some fields
+ # set before other fields.
+ my %WOR = (
+ headline => 'Test WOR',
+ description => 'This is a test WOR created programmatically',
+ project => 'MUOS',
+ RCLC_name => 'Test RCLC',
+ Prod_Arch1 => 'testcode : N/A',
+ work_product_name => '10 - Software',
+ #Engr_target => 'Test Engineering Target',
+ work_code_name => 'RAN-RW2',
+ );
+
+ return AddRecord('WOR', \%WOR, ['project', 'Prod_Arch1']);
+} # CreateWOR
+
+sub CreateView($) {
+ my ($WORID) = @_;
+
+ my ($status, @output) = Execute "$createView $WORID 2>&1";
+
+ $log->log($_) for @output;
+
+ return $status;
+} # CreateView
+
+sub Cleanup($) {
+ my ($WORID) = @_;
+
+ my ($status, @output) = (0, ());
+ my $rc = 0;
+
+ # Remove views created
+ my @tags = (
+ "$ENV{USER}_${project}_intview",
+ "$ENV{USER}_${WORID}_devview",
+ );
+
+ for (@tags) {
+ my $view = Clearcase::View->new($_);
+
+ $log->msg('Removing ' . $view->name);
+
+ ($rc, @output) = $view->remove;
+
+ $status++ if $rc;
+
+ $log->log($_) for @output;
+ } # for
+
+ # Remove streams that were created
+ my @streams = (
+ "$ENV{USER}_${WORID}_${project}_dev",
+ );
+
+ for my $stream (@streams) {
+ my $activity = Clearcase::UCM::Activity->new($WORID, $test_pvob);
+
+ $log->msg('Removing ' . $activity->name);
+
+ ($rc, @output) = $activity->remove;
+
+ $status += $rc;
+
+ $log->log($_) for @output;
+
+ # Streams are downshifted
+ my $stream = Clearcase::UCM::Stream->new(lc $stream, $test_pvob);
+
+ $log->msg('Removing ' . $stream->name);
+
+ ($rc, @output) = $stream->remove;
+
+ $log->log($_) for @output;
+
+ $status++ if $rc;
+ } # for
+
+ return $status;
+} # Cleanup
## Main
-GetOptions (
+GetOptions(
\%opts,
- usage => sub { Usage },
+ usage => sub { pod2usage },
+ help => sub { pod2usage (-verbose => 2)},
verbose => sub { set_verbose },
debug => sub { set_debug },
'get',
'modify',
'change',
'delete',
- 'module=s',
'username=s',
'password=s',
'database=s',
'dbset=s',
- 'server=s',
- 'port=i',
-) || Usage;
+) || pod2usage;
my $processStartTime = time;
+# Since we are creating private vobs (to avoid complications with having to
+# know and code the registry password when making public vobs), we'll simply
+# change $Clearcase::VOBTAG_PREFIX
+if ($ARCHITECTURE !~ /win/i) {
+ $Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp';
+} # if
+
local $| = 1;
# Translate any options to ones that the lib understands
-$opts{CQ_USERNAME} = delete $opts{username};
-$opts{CQ_PASSWORD} = delete $opts{password};
-$opts{CQ_DATABASE} = delete $opts{database};
-$opts{CQ_DBSET} = delete $opts{dbset};
-$opts{CQ_SERVER} = delete $opts{server};
-$opts{CQ_PORT} = delete $opts{port};
-$opts{CQ_MODULE} = delete $opts{module};
+map {$opts{$_} = $Clearquest::OPTS{$_}} keys %Clearquest::OPTS;
+
+$opts{CQ_USERNAME} = delete $opts{username} if $opts{username};
+$opts{CQ_PASSWORD} = delete $opts{password} if $opts{password};
+$opts{CQ_DATABASE} = delete $opts{database} if $opts{database};
+$opts{CQ_DBSET} = delete $opts{dbset} if $opts{dbset};
+$opts{CQ_SERVER} = delete $opts{server} if $opts{server};
+$opts{CQ_PORT} = delete $opts{port} if $opts{port};
+$opts{CQ_MODULE} = delete $opts{module} if $opts{module};
# If nothing is set then do everything
unless ($opts{get} or
my $startTime = time;
-$cq = Clearquest->new (%opts);
+$log = Logger->new;
-display_nolf 'Connecting to Clearquest database ' . $cq->connection;
+$cq = Clearquest->new(%opts);
+
+$log->msg('Connecting to Clearquest database ' . $cq->connection . '...', 1);
unless ($cq->connect) {
- $cq->checkErr ('Unable to connect to database ' . $cq->connection);
-
+ $cq->checkErr('Unable to connect to database ' . $cq->connection, undef, $log);
+
if ($cq->module eq 'client') {
- display 'Unable to connect to server '
- . $cq->server ()
- . ':'
- . $cq->port ();
+ $log->msg('Unable to connect to server ' . $cq->server() . ':' . $cq->port());
} # if
-
+
exit $cq->error;
} else {
- display '';
- display_duration $startTime;
+ $log->msg('connected');
+ display_duration $startTime, $log;
} # unless
-$cq->setOpts (emptyStringForUndef => 1);
+$cq->setOpts(emptyStringForUndef => 1);
+# Check a few required stateless records
if ($opts{get}) {
# Get record by key
- testGetRecord 'Project', 'Athena';
+ $status += GetRecord 'Project', 'MUOS- EC';
# Get record by condition
- testFindRecord 'VersionInfo', 'Deprecated = 1';
-
- # Get record by key with field list
- testFindRecord 'VersionInfo', 'VersionStr = 1.0', ('VersionStr', 'Deprecated');
+ $status += FindRecord 'Platform_Options', 'Platform = "Unix"';
# Get record by condition with field list
- testFindRecord 'CategorySub', 'Category="Software"', ('Category', 'CategoryType', 'SubCategory');
+ $status += FindRecord 'Roles', 'Rank = "Supervisor"', ('user_name', 'teams.Name', 'Rank');
} # if
if ($opts{add}) {
- # Add a record
- testAddRecord 'VersionInfo', (
- VersionStr => '2.0',
- Projects => ['Island', '21331', 'Hera'],
- Visibility => 'Nokia Corporation',
+ my %component = (
+ Name => $FindBin::Script,
+ Description => 'This is a test component',
);
+
+ AddRecord('Component', \%component, undef, 'name');
+
+ $status++ if $cq->error;
} # if
if ($opts{modify}) {
# Modify a record
- testModifyRecord ('VersionInfo', '1.0', (
- Deprecated => 1,
- Projects => ['Island', 'Athena'],
- ));
+ my $newDescription = 'This is a modified test component';
+
+ $status += ModifyRecord('Component', $FindBin::Script, (Description => $newDescription));
+
+ # Make sure the modification happened
+ my %component = $cq->get('Component', $FindBin::Script, ('Description'));
+
+ $log->err('Modification of Component.Description failed!')
+ if $component{Description} ne $newDescription;
} # if
+DeleteRecord 'Component', $FindBin::Script if $opts{add};
+
+$log->msg('Enable tc.project for integration with Clearquest');
+
+$test_pvob = Clearcase::UCM::Pvob->new("${Clearcase::VOBTAG_PREFIX}tc.pvob");
+$test_project = Clearcase::UCM::Project->new('tc.project', 'tc.folder', $test_pvob);
+
+my ($rc, @output) = $test_project->change("-force -crmenable $opts{CQ_DATABASE}");
+
+$status += $rc;
+
+$log->log($_) for @output;
+
+$log->msg('Create WOR');
+
+my $WORID = CreateWOR;
+
+unless ($WORID) {
+ $status++;
+
+ exit $status;
+} else {
+ $log->msg("Created WOR $WORID");
+} # unless
+
if ($opts{change}) {
- # Change State
- testChangeState 'Defect', 'apd00000034';
+ my $worStatus;
+
+ $worStatus += AssignWOR $WORID;
+ $worStatus += ActivateWOR $WORID;
+
+ $status += $worStatus;
+
+ unless ($worStatus) {
+ # If we weren't able to assign and activate the WOR then there's no need
+ # to create the view and no need to clean up unless we created the view.
+ $worStatus = CreateView $WORID;
+
+ $status += Cleanup($WORID) unless $worStatus;
+
+ $status += $worStatus;
+ } # unless
} # if
-if ($opts{add}) {
- # Delete that record
- testDeleteRecord 'VersionInfo', '2.0';
+if ($status) {
+ $log->err('Clearquest tests FAILED');
+} else {
+ $log->msg('Clearquest tests PASSED');
} # if
-display_nolf 'Total process time ';
+$log->msg('Total process time ', 1);
+
+display_duration $processStartTime, $log;
-display_duration $processStartTime;
+exit $status;
projects / clearscm.git / commitdiff