# 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
--- /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
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:\\IBMRational\\RationalSDLC\\Clearcase';
- $CCHOME = 'D:\\Program Files\\Rational\\Clearcase'
+ $CCHOME = 'D:\\IBMRational\\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
# run as a plain user who does not have cleartool in their path.
my $cleartool;
- if ($ARCH =~ /Win/ or $ARCH eq 'cygwin') {
+ if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') {
$cleartool = 'cleartool';
} elsif (-x '/opt/rational/clearcase/bin/cleartool') {
$cleartool = '/opt/rational/clearcase/bin/cleartool';
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
return $self->{name};
} # name
-sub pvob () {
+sub pvob() {
my ($self) = @_;
=pod
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
=for html </blockquote>
=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});
+ $comment = Clearcase::_setComment $comment;
- 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(
+ "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);
+ $opts ||= '';
- return;
+ 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
$cmd .= " -predeccsor";
} # if
- $Clearcase::CC->execute ($cmd);
+ $Clearcase::CC->execute($cmd);
return if $Clearcase::CC->status;
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}->name);
+} # 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});
+} # 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}->name);
+} # rmProject
+
+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 () {
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 baseline
+=item project
-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
+
+=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
+ ('rmstream -f ' . $self->{name} . '@' . $self->{pvob}->name);
+} # rmStream
+
+sub rebase($;$) {
+ my ($self, $baseline, $opts) = @_;
+
+=pod
+
+=head2 rebase
-UCM Project this stream belongs to
+Rebases a UCM Stream
-=item PVOB (Required)
+Parameters:
-Project Vob
+=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 .= ' -baseline ' . $baseline .
+ ' -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 baselines () {
my ($self) = @_;
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
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;
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
} # 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});
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
+ TERM=xterm
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
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}
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 PERL5LIB=/cleartrig/ent/SNSD/muos/ccadm_tools/vobs/ranccadm/scripts/lib:$PERL5LIB
export TZ="US/Arizona"
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"
+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"
alias xemacs="ssh muosbldforge2 xemacs"
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
+
+# Additional paths...
+append_to_path "/c/Program Files/IBM/RationalSDLC/common"
+append_to_path "/d/Program Files/IBM/RationalSDLC/common"
+append_to_path "/c/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin"
+append_to_path "/d/Program Files/IBM/RationalSDLC/Clearquest/cqcli/bin"
+append_to_path "/c/Program Files/IBM/RationalSDLC/ClearCase/bin"
+append_to_path "/d/Program Files/IBM/RationalSDLC/ClearCase/bin"
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" = "xterm" -o \
+ "$TERM" = "xtermc" -o \
+ "$TERM" = "xterm-256color" -o \
+ "$TERM" = "vt220" ]; then
+ ROOT="\[${ROOT_COLOR}\]Wizard\[$NORMAL\] "
+ else
+ ROOT="Wizard "
fi
else
ROOT=""
if [ "$TERM" = "vt100" -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" = "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\
# Aliasing
case "$SYSNAME" in
- C02s608vg8wp)
+ Az25jzhxkb2d)
SYSNAME="Venus"
;;
esac
--- /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: view2
+viewpath: /net/$viewhost
+viewstore: $viewpath/local/view2c
-#!/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)
+
+=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 Getopt::Long;
use Term::ANSIColor qw(:constants);
-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 (@ucmobjs, $order);
+
+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 ($vbs, $vws, %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) {
+ if (ref $opts{$_} eq 'ARRAY') {
+ my $name = $_;
+ $log->msg("$name:\t$_") for (@{$opts{$_}});
+ } else {
+ $log->msg("$_:\t$opts{$_}");
+ } # 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);
+
+ push @ucmobjs, $pvob unless $status;
+
+ 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->msg('Unmounting vob ' . $vob->tag);
+
+ ($status, @output) = $vob->umount;
+
+ $log->msg('Removing vob ' . $vob->tag);
+
+ ($status, @output) = $vob->remove;
+
+ $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");
-my ($status, @output) = $Clearcase::CC->execute ('-ver');
+ $log->log($_) for (@output);
-error 'Clearcase is not installed on this system', 1
- if $status;
+ 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 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
-display YELLOW . "Global Clearcase Variables\n" . RESET;
+ 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 $status = 0;
+
+ # Need to remove UCM objects in the opposite order in which we created them
+ for (reverse @ucmobjs) {
+ my ($rc, @output);
+
+ if (ref $_ eq 'Clearcase::UCM::Pvob') {
+ $log->msg('Removing Pvob ' . $_->tag);
+
+ $status += DestroyVob $_;
+ } else {
+ $log->msg('Removing ' . ref ($_) . ' ' . $_->name);
+
+ ($rc, @output) = $_->remove;
+
+ $status += $rc;
+ } # if
+ } # for
+
+ 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");
+
+ if ($status != 0) {
+ $log->log($_) for (@output);
+ } # if
+
+ return $status;
+} # SetupTest
+
+sub SetupUCMTest() {
+ my $status;
+
+ $log->msg("Creating UCM Pvob $Clearcase::VOBTAG_PREFIX/tc.pvob");
+
+ ($status, $test_pvob) = CreatePvob("$Clearcase::VOBTAG_PREFIX/tc.pvob");
+
+ return $status;
+} # SetupUCMTest
+
+sub CreateUCMProject() {
+ # Get the root folder to put this project into (may create folders later)
+ my $folder = Clearcase::UCM::Folder->new('tc.folder', $test_pvob);
+
+ $test_project = Clearcase::UCM::Project->new('tc.project', $folder, $test_pvob);
+
+ $log->msg('Creating UCM Project tc.project');
+
+ my ($status, @output) = $test_project->create();
+
+ $log->log($_) for (@output);
+
+ push @ucmobjs, $test_project unless $status;
+
+ 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);
+
+ push @ucmobjs, $test_intstream unless $status;
+
+ 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);
+
+ push @ucmobjs, $test_devstream unless $status;
+
+ return $status;
+} # CreateUCMIntStream
+
+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);
+
+ push @ucmobjs, $test_component unless $status;
+
+ 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);
+
+ push @ucmobjs, $test_intview unless $status;
+
+ $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);
+
+ push @ucmobjs, $test_devview unless $status;
+
+ $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);
+
+ push @ucmobjs, $test_baseline unless $status;
+
+ 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);
+
+ push @ucmobjs, $test_activity unless $status;
+
+ return $status;
+} # CreateUCMActivity
+
+sub RebaseStream($$;$) {
+ my ($stream, $baseline, $opts) = @_;
+
+ my ($status, @output) = $stream->rebase($baseline, $opts);
+
+ $log->log($_) for (@output);
+
+ return $status;
+} # RebaseStream
+
+sub RecommendBaseline($) {
+ my ($baseline) = @_;
+
+ my ($status, @output) = $test_intstream->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 += CreateUCMDevView;
+ $status += CreateUCMComponent;
+ $status += AddModifiableComponent;
+ $status += RebaseStream($test_intstream, 'tc.component_INITIAL', '-complete');
+ $status += RecommendBaseline('tc.component_INITIAL');
+ $status += CreateUCMBaseline;
+ $status += RebaseStream($test_devstream, 'tc.baseline', '-complete');
+ $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{base} = 1;
+$opts{clean} = 1;
+
+GetOptions(
+ \%opts,
+ 'verbose' => sub { set_verbose },
+ 'debug' => sub { set_debug },
+ 'usage' => sub { Usage },
+ 'config=s',
+ 'base!',
+ 'ucm!',
+ 'clean!',
+) 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
+for (keys %default_opts) {
+ $opts{$_} = $default_opts{$_} if !$opts{$_};
+} # for
+
+$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
+$Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp';
+
+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} and !$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>
+
+L<FindBin>
+
+L<Getopt::Long|Getopt::Long>
+
+L<Term::ANSIColor|Term::ANSIColor>
-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;
use Clearquest;
use Display;
+use Logger;
use TimeUtils;
use Utils;
-my ($cq, %opts);
+my ($cq, %opts, $log);
sub displayRecord (%) {
my (%record) = @_;
- display '-' x 79;
+ $log->msg ('-' x 79);
- foreach (keys %record) {
- display_nolf "$_: ";
+ 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
if (@records) {
displayRecord %$_ foreach (@records);
} else {
- display "Did not find any records";
+ $log->msg ('Did not find any records');
} # if
return;
my $startTime = time;
- display "Testing get table: $table key: $key";
+ $log->msg ("Testing get table: $table key: $key");
displayRecord $cq->get ($table, $key, @fields);
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testGetRecord
my $startTime = time;
- display "Testing find table: $table condition: $condition";
+ $log->msg ("Testing find table: $table condition: $condition");
my ($result, $nbrRecs) = $cq->find ($table, $condition, @fields);
- display "$nbrRecs records qualified";
+ $log->msg ("$nbrRecs records qualified");
- while (my %record = $cq->getNext ($result)) {
+ while (my %record = $cq->getNext($result)) {
displayRecord %record;
} # while
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testFindRecord
my $startTime = time;
- display "Testing modify table: $table key: $key";
+ $log->msg ("Testing modify table: $table key: $key");
$cq->modify ($table, $key, undef, \%update);
$cq->checkErr;
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testModifyRecord
$update{Stability_Issue} = 'Assert';
} # if
- display "Testing change state table: $table key: $key action: $action";
+ $log->msg ("Testing change state table: $table key: $key action: $action");
$cq->modify ($table, $key, $action, \%update);
$cq->checkErr;
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testChangeState
my $startTime = time;
- display "Testing adding table: $table";
+ $log->msg ("Testing adding table: $table");
- $cq->add ($table, \%record, qw(Projects VersionStr));
+ $cq->add ($table, \%record);
$cq->checkErr;
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testAddRecord
my $startTime = time;
- display "Testing deleting table: $table key: $key";
+ $log->msg ("Testing deleting table: $table key: $key");
$cq->delete ($table, $key);
$cq->checkErr;
- display_duration $startTime;
+ display_duration $startTime, $log;
return;
} # testDeleteRecord
my $startTime = time;
+$log = Logger->new;
+
$cq = Clearquest->new (%opts);
-display_nolf 'Connecting to Clearquest database ' . $cq->connection;
+$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 ('');
+ display_duration $startTime, $log;
} # unless
$cq->setOpts (emptyStringForUndef => 1);
if ($opts{get}) {
# Get record by key
- testGetRecord 'Project', 'Athena';
+ testGetRecord 'WOR', 'XTST100000019';
# Get record by condition
- testFindRecord 'VersionInfo', 'Deprecated = 1';
+ testFindRecord 'WOR', 'Owner = "ccadm"';
# Get record by key with field list
- testFindRecord 'VersionInfo', 'VersionStr = 1.0', ('VersionStr', 'Deprecated');
+ testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner');
# Get record by condition with field list
- testFindRecord 'CategorySub', 'Category="Software"', ('Category', 'CategoryType', 'SubCategory');
+ testFindRecord 'WOR', 'Owner = "ccadm"', ('id', 'Headline', 'Owner');
} # if
if ($opts{add}) {
# Add a record
- testAddRecord 'VersionInfo', (
- VersionStr => '2.0',
- Projects => ['Island', '21331', 'Hera'],
- Visibility => 'Nokia Corporation',
+ testAddRecord 'Component', (
+ Name => $FindBin::Script,
+ Description => 'This is a test component',
);
} # if
if ($opts{modify}) {
# Modify a record
- testModifyRecord ('VersionInfo', '1.0', (
- Deprecated => 1,
- Projects => ['Island', 'Athena'],
- ));
+ my $newDescription = 'This is a modified test component';
+
+ testModifyRecord ('Component', $FindBin::Script, (Description => $newDescription));
+
+ # Make sure the modification happened
+ my %component = $cq->get ('Component', $FindBin::Script, ('Description'));
+
+ if ($component{Description} ne $newDescription) {
+ $log->err ('Modification of Component.Description failed!');
+ } # if
} # if
if ($opts{change}) {
if ($opts{add}) {
# Delete that record
- testDeleteRecord 'VersionInfo', '2.0';
+ testDeleteRecord 'Component', $FindBin::Script;
} # if
-display_nolf 'Total process time ';
+$log->msg ('Total process time ', 1);
-display_duration $processStartTime;
+display_duration $processStartTime, $log;
projects / clearscm.git / commitdiff