From e907bf835bb61d8888f2fcd59c90bd071e841cf7 Mon Sep 17 00:00:00 2001 From: Andrew DeFaria Date: Wed, 29 Aug 2018 20:18:40 -0700 Subject: [PATCH] More changes to Clearcase and Clearquest stuff --- bin/bigfiles.pl | 31 ++++--- lib/Clearcase.pm | 8 +- lib/Clearcase/UCM/Folder.pm | 7 +- lib/Clearcase/UCM/Pvob.pm | 47 +---------- lib/Clearcase/View.pm | 59 +++++++------ lib/Clearcase/Vob.pm | 2 + lib/Utils.pm | 2 +- rc/clearcase | 12 +-- test/testMachinesMySQL.pl | 72 ++++++++++++++++ test/testclearcase.pl | 160 +++++------------------------------- test/testclearquest.pl | 4 +- 11 files changed, 163 insertions(+), 241 deletions(-) create mode 100755 test/testMachinesMySQL.pl diff --git a/bin/bigfiles.pl b/bin/bigfiles.pl index 3c539c2..a020f19 100755 --- a/bin/bigfiles.pl +++ b/bin/bigfiles.pl @@ -43,7 +43,9 @@ sub Bigfiles { foreach (@dirs) { next if !-d "$_"; - my $cmd = "find \"$_\" -xdev -type f -size +$size -exec ls -lLG {} \\;"; + + my $lsOpts = $ARCHITECTURE eq 'solaris' ? '-loL' : '-lLG'; + my $cmd = "find \"$_\" -xdev -type f -size +$size -exec ls $lsOpts {} \\;"; my @lines = `$cmd`; foreach (@lines) { @@ -52,7 +54,7 @@ sub Bigfiles { my %info; #if (/\S+\s+\d+\s+(\S+)\s+(\d+).*\"\.\/(.*)\"/) { - if (/\S+\s+\d+\s+(\S+)\s+\S+ \S+\s+(\d+)\s+\S+\s+\d+\s+\S+\s+(\S+)/){ + if (/\S+\s+\d+\s+(\S+)\s+(\d+)\s+\S+\s+\S+\s+\d+\s+(.*)/) { $info {user} = $1; $info {filesize} = $2; $info {filename} = $3; @@ -70,7 +72,9 @@ my $top = $lines - 2; my $bytes_in_meg = 1048576; my $block_size = 512; my $size_in_meg = 1; -my %opts; +my %opts = ( + size => 1 +); my $result = GetOptions ( \%opts, @@ -81,23 +85,26 @@ my $result = GetOptions ( 'size=i', ); -my @dirs = @ARGV || '.'; -my $size = $opts {size} ? $opts {size} * $bytes_in_meg / $block_size : 4096; +my @dirs = @ARGV > 0 ? @ARGV : '.'; +my $size = $opts{size} ? $opts{size} * $bytes_in_meg / $block_size : 4096; +my @files; # Now do the find -verbose "Directory:\t$_" +verbose "Directory:\t@dirs"; -foreach (@dirs) { - verbose "Size:\t\t$size_in_meg Meg ($size blocks)"; +for (@dirs) { + verbose "Size:\t\t$opts{size} Meg ($size blocks)"; verbose "Top:\t\t$top"; my $head = $top ? "cat" : "head -$top"; - my @files = Bigfiles $size, @dirs; -} # for each + @files = Bigfiles $size, @dirs; +} # for -foreach (@files) { +for (sort {$b->{filesize} <=> $a->{filesize}} @files) { my %info = %{$_}; + last if $top-- == 0; + print "${info {filesize}}\t${info {user}}\t${info {filename}}\n"; -} # foreach +} # for diff --git a/lib/Clearcase.pm b/lib/Clearcase.pm index 81822dd..a845184 100644 --- a/lib/Clearcase.pm +++ b/lib/Clearcase.pm @@ -82,7 +82,7 @@ use Display; my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool); -our $VIEW_DRIVE = $ENV{CLEARCASE_VIEW_DRIVE} || 'M'; +our $VIEW_DRIVE = 'M'; our $VOB_MOUNT = 'vob'; our $WIN_VOB_PREFIX = '\\'; our $SFX = $ENV{CLEARCASE_XN_SFX} ? $ENV{CLEARCASE_XN_SFX} : '@@'; @@ -118,9 +118,9 @@ BEGIN { # 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 (x86)\\ibm\\RationalSDLC\\Clearcase'; + $CCHOME = 'C:\\IBMRational\\RationalSDLC\\Clearcase'; - $CCHOME = 'D:\\Program Files (x86)\\ibm\\RationalSDLC\\Clearcase' + $CCHOME = 'D:\\IBMRational\\RationalSDLC\\Clearcase' unless -d $CCHOME; error 'Unable to figure out where Clearcase is installed', 1 @@ -579,7 +579,7 @@ Array of output lines from the cleartool command execution. # to use these Clearcase objects say in a web page where the server is often # run as a plain user who does not have cleartool in their path. unless ($cleartool) { - if ($ARCHITECTURE =~ /Win/i or $ARCHITECTURE eq 'cygwin') { + if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') { $cleartool = 'cleartool'; } elsif (-x '/opt/rational/clearcase/bin/cleartool') { $cleartool = '/opt/rational/clearcase/bin/cleartool'; diff --git a/lib/Clearcase/UCM/Folder.pm b/lib/Clearcase/UCM/Folder.pm index d606d62..0d0da46 100644 --- a/lib/Clearcase/UCM/Folder.pm +++ b/lib/Clearcase/UCM/Folder.pm @@ -96,7 +96,11 @@ Returns: "mkfolder $comment -in " . $class->{parent} . ' ' . $name . '@' . $pvob->tag ); - return $class->updateFolderInfo; + return if $status; + + ($status, @output) = $class->updateFolderInfo; + + return $status ? undef : $class; } # new sub name () { @@ -416,6 +420,7 @@ sub updateFolderInfo () { return $self; } # updateFolderInfo + 1; =head1 DEPENDENCIES diff --git a/lib/Clearcase/UCM/Pvob.pm b/lib/Clearcase/UCM/Pvob.pm index 0b39949..86629c1 100644 --- a/lib/Clearcase/UCM/Pvob.pm +++ b/lib/Clearcase/UCM/Pvob.pm @@ -47,9 +47,7 @@ package Clearcase::UCM::Pvob; use strict; use warnings; -# Would be better represented by use parent "Clearcase::Vob" but we're -# working with old versions of Perl here... -use base 'Clearcase::Vob'; +use parent 'Clearcase::Vob'; use Carp; @@ -93,7 +91,8 @@ Returns: croak 'Clearcase::UCM::Pvob: Must specify pvob tag' unless $tag; $class = bless { - tag => $tag, + tag => $tag, + ucmproject => 1, }, $class; # bless $class->updateVobInfo; @@ -101,46 +100,6 @@ Returns: return $class; } # new -sub create (;$$$%) { - my ($self, $host, $vbs, $comment, %opts) = @_; - -=pod - -=head2 create - -Creates a pvob - -Parameters: - -=for html
- -=over - -=item none - -=back - -=for html
- -Returns: - -=for html
- -=over - -=item none - -=back - -=for html
- -=cut - - $opts{ucmproject} = undef; - - return $self->SUPER::create ($host, $vbs, $comment, %opts); -} # create - sub tag() { my ($self) = @_; diff --git a/lib/Clearcase/View.pm b/lib/Clearcase/View.pm index 77cfc6a..7a59cd2 100644 --- a/lib/Clearcase/View.pm +++ b/lib/Clearcase/View.pm @@ -127,8 +127,8 @@ use warnings; use Clearcase; use Display; -sub new ($) { - my ($class, $tag) = @_; +sub new ($;$) { + my ($class, $tag, $region) = @_; =pod @@ -172,7 +172,7 @@ Returns: my $self = bless { tag => $tag }, $class; - $self->updateViewInfo; + $self->updateViewInfo ($region); return $self; } # new @@ -1170,11 +1170,6 @@ Returns: return $self->{tag}; } # tag -# Alias name to tag -sub name() { - goto &tag; -} # name - sub text_mode () { my ($self) = @_; @@ -1368,7 +1363,7 @@ Returns: } # exists sub create (;$$$) { - my ($self, $host, $vws, $opts) = @_; + my ($self, $host, $vws, $region) = @_; =pod @@ -1414,37 +1409,34 @@ Ouput from cleartool =cut + $region ||= $Clearcase::CC->region; + if ($self->exists) { - $self->updateViewInfo; + $self->updateViewInfo ($region); return (0, ()) } # if my ($status, @output); - $opts ||= ''; - if ($host && $vws) { - ($status, @output) = $Clearcase::CC->execute( - "mkview -tag $self->{tag} $opts " . - "-host $host -hpath $vws -gpath $vws $vws" - ); + ($status, @output) = + $Clearcase::CC->execute ("mkview -tag $self->{tag} -region $region " + . "-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} $opts -stgloc -auto" - ); + ($status, @output) = + $Clearcase::CC->execute ("mkview -tag $self->{tag} -stgloc -auto"); } # if - $self->updateViewInfo; + $self->updateViewInfo ($region); return ($status, @output); } # create -# TODO Is this used? sub createUCM ($$) { - my ($self, $stream, $pvob) = @_; + my ($self, $stream, $pvob, $region) = @_; =pod @@ -1490,10 +1482,14 @@ Array of output =cut - return (0, ()) if $self->exists; + $region ||= $Clearcase::CC->region; + + return (0, ()) + if $self->exists; # Update object members - $self->{pvob} = $pvob; + $self->{stream} = $stream; + $self->{pvob} = $pvob; # Need to create the view my ($status, @output) = @@ -1503,7 +1499,7 @@ Array of output return ($status, @output) if $status; - $self->updateViewInfo; + $self->updateViewInfo ($region); return ($status, @output); } # createUCM @@ -1549,13 +1545,12 @@ Ouput from cleartool =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}" ); @@ -1749,11 +1744,13 @@ Ouput from cleartool return ($status, @output); } # set -sub updateViewInfo () { - my ($self) = @_; +sub updateViewInfo ($$) { + my ($self, $region) = @_; + + $region ||= $Clearcase::CC->region; my ($status, @output) = $Clearcase::CC->execute ( - "lsview -long -properties -full $self->{tag}" + "lsview -region $region -long -properties -full $self->{tag}" ); # Assuming this view is an empty shell of an object that the user may possibly diff --git a/lib/Clearcase/Vob.pm b/lib/Clearcase/Vob.pm index 142c1dc..ca4f765 100644 --- a/lib/Clearcase/Vob.pm +++ b/lib/Clearcase/Vob.pm @@ -1248,6 +1248,8 @@ Ouput from cleartool } # for if ($host && $vbs) { + $additionalOpts .= '-ucmproject' if $self->{ucmproject}; + ($status, @output) = $Clearcase::CC->execute ( "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs " . "-gpath $vbs $vbs"); diff --git a/lib/Utils.pm b/lib/Utils.pm index f52fe4b..8aabcaa 100644 --- a/lib/Utils.pm +++ b/lib/Utils.pm @@ -357,7 +357,7 @@ Returns: while () { my $key; - while (not defined ($key = ReadKey -1)) { } + while (not defined ($key = ReadKey -1)) { } if ($key =~ /(\r|\n)/) { print "\n"; diff --git a/rc/clearcase b/rc/clearcase index 1c33ad1..14a3d88 100644 --- a/rc/clearcase +++ b/rc/clearcase @@ -132,11 +132,11 @@ function lllock { # View related functions function setview { if [ $ARCHITECTURE = 'cygwin' ]; then - if [[ $1 = -* ]]; then - echo "The setview command with options is not supported on Windows" - return - fi - + if [[ $1 = -* ]]; then + echo "The setview command with options is not supported on Windows" + return + fi + # Save off where we are back=$PWD @@ -148,7 +148,7 @@ function setview { fi # Setup $VOBTAG_PREFIX - mount -f -o binary $CLEARCASE_VIEW_DRIVE:/$1 $LINUX_VOBTAG_PREFIX + mount -f -o binary M:/$1 $LINUX_VOBTAG_PREFIX # Start a bash shell bash diff --git a/test/testMachinesMySQL.pl b/test/testMachinesMySQL.pl new file mode 100755 index 0000000..af13546 --- /dev/null +++ b/test/testMachinesMySQL.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Getopt::Long; +use Pod::Usage; + +use FindBin; + +use lib "$FindBin::Bin/../lib"; + +use Display; +use Machines::MySQL; +use Utils; + +my %opts = ( + usage => sub { podusage() } , + hostname => $ENV{HOST} || 'localhost', + username => $ENV{USERNAME} ? $ENV{USERNAME} : $ENV{USER}, + password => $ENV{PASSWORD}, + database => 0, +); + +sub AddSystems($) { + my ($machines) = @_; + + my @machines = $machines->ReadSystemsFile; + + for (@machines) { + my ($err, $msg) = $machines->AddSystem(%$_); + + error ($msg) if $err; + } # for +} # AddSystems + +GetOptions ( + \%opts, + 'usage', + 'host=s', + 'username=s', + 'password=s', + 'database', + 'filename=s', +); + +my $machines; + +unless ($opts{database}) { + require Machines; Machines->import; + + $machines = Machines->new(filename => $opts{filename}); +} else { + require Machines::MySQL; Machines::MySQL->import; + + $machines = Machines::MySQL->new; +} # if + +#for ($machines->select ("os = '2.4.21-50.Elsmp'")) { + +if (ref($machines) eq 'Machines') { + display "From file:"; +} elsif (ref($machines) eq 'Machines::MySQL') { + display "From database"; +} # if + +my %records = $machines->select; + +for (sort keys %records) { + display "Would execute command on $_ ($records{$_}{model})"; +} # for + +display "done"; diff --git a/test/testclearcase.pl b/test/testclearcase.pl index 545f3d0..512d372 100755 --- a/test/testclearcase.pl +++ b/test/testclearcase.pl @@ -43,17 +43,6 @@ $Date: 2011/01/09 01:01:32 $ -[no]uc|m: Perform UCM Clearcase tests (Default: noucm) -[no]clean: Cleanup after yourself (Default: clean) -if -ucm is specified then the following additional parameters should be set: - - -username: Username to connect to Clearquest with (Can set CQ_USERNAME) - -password: Password to use to connect to Clearquest (CQ_PASSWORD) - -weburl: Web URL to use for enabling Clearcase -> Clearquest - connection (CQ_WEBURL - Do not specify the trailing - "/oslc") - -database: Clearquest database to enable (CQ_DATABASE) - -dbset: Clearquest DBSet (CQ_DBSET) - -provider: Name of provider (Default: CQPROV) - =head1 DESCRIPTION Clearcase smoke tests. Perform simple Clearcase operations to validate that @@ -69,7 +58,7 @@ use warnings; use Cwd; use FindBin; use Getopt::Long; -use Pod::Usage; +#use Term::ANSIColor qw(:constants); use lib "$FindBin::Bin/../lib"; @@ -131,20 +120,11 @@ sub LogOpts() { ); for (sort keys %opts) { - next if /help/ || /usage/ || /password/; - if (ref $opts{$_} eq 'ARRAY') { my $name = $_; - - for (@{$opts{$_}}) { - $log->msg("$name:\t$_") if $_; - } # for + $log->msg("$name:\t$_") for @{$opts{$_}}; } else { - if ($opts{$_}) { - $log->msg("$_:\t$opts{$_}"); - } else { - $log->msg("$_:\t"); - } # if + $log->msg("$_:\t$opts{$_}"); } # if } # for @@ -208,28 +188,14 @@ sub DestroyVob($) { ($status, @output) = $Clearcase::CC->execute('cd'); - $log->err('Unable to perform cd command', 1) if $status; - $log->msg('Unmounting vob ' . $vob->tag); ($status, @output) = $vob->umount; - if ($status) { - $log->err('Unable to unmount vob ' . $vob->tag); - } else { - $log->msg('Umounted vob ' . $vob->tag); - } # if - $log->msg('Removing vob ' . $vob->tag); ($status, @output) = $vob->remove; - if ($status) { - $log->err("Failed to execute command " . - $Clearcase::CC->lastcmd . "\n" . - join "\t\n", @output); - } # if - $log->log($_) for @output; return $status; @@ -261,18 +227,6 @@ sub SetView($) { return $status; } # SetView -sub StopView($) { - my ($view) = @_; - - $log->msg('Stopping view ' . $view->tag); - - my ($status, @output) = $view->stop; - - $log->log($_) for @output; - - return $status; -} # StopView - sub DestroyView($) { my ($view) = @_; @@ -492,7 +446,7 @@ sub CleanupUCM() { ($rc, @output) = $test_activity->remove; $status += $rc; - + $log->log($_) for @output; # Need to remove baselines from streams first using rebase (Devstream) @@ -550,7 +504,7 @@ sub CleanupUCM() { $log->log($_) for @output; $status += DestroyView($test_intview); - + $log->msg('Removing '. $test_devstream->name); ($rc, @output) = $test_devstream->remove; @@ -640,71 +594,19 @@ sub SetupTest($$) { ($status, @output) = $Clearcase::CC->execute("cd $dir"); - $log->log($_) for @output; + if ($status != 0) { + $log->log($_) for @output; + } # if return $status; } # SetupTest -sub SetupAttributeTypes() { - my @CC_CMI_Types = qw(CONTEXT TASK PROVIDERS); - - my $status = SetView($test_intview); - - return $status if $status; - - for (@CC_CMI_Types) { - my $cmd = "mkattype -nc -vtype string CC_CMI_$_"; - - my ($rc, @output) = $Clearcase::CC->execute($cmd); - - $status += $rc; - - $log->log($_) for @output; - } # for - - return $status; -} # SetupAttributeTypes - -sub CRMRegister() { - my $cmd = "crmregister add -database $opts{database} -connection RDE " - . "-url $opts{weburl} -username $opts{username} " - . "-password $opts{password}"; - - my ($status, @output) = Execute $cmd; - - $log->log($_) for @output; - - return $status; -} # CRMRegister - -sub MakeCMProvider() { - my $cmd = 'mkcmprovider -vob ' . $test_pvob->tag - . '-type cmcq -version V1_0 -description ' - . '"RDE CMI CQ Provider" ' - . '-connection baseurl:' . $opts{weburl} . " $opts{provider}"; - - my ($status, @output) = $Clearcase::CC->execute($cmd); - - $log->log($_) for @output; - - return $status; -} # MakeCMProvider - sub SetupUCMTest() { my $status; - $log->msg("Register RDE://$opts{username}\@$opts{database}"); - - $status = CRMRegister; - - $log->err("Unable to register RDE://$opts{username}\@$opts{database} - Check logfile", $status) - if $status; + $log->msg("Creating UCM Pvob $Clearcase::VOBTAG_PREFIX/tc.pvob"); - $log->msg("Creating UCM Pvob ${Clearcase::VOBTAG_PREFIX}tc.pvob"); - - ($status, $test_pvob) = CreatePvob("${Clearcase::VOBTAG_PREFIX}tc.pvob"); - - MountVob $test_pvob; + ($status, $test_pvob) = CreatePvob("$Clearcase::VOBTAG_PREFIX/tc.pvob"); return $status; } # SetupUCMTest @@ -716,7 +618,7 @@ sub CreateUCMProject() { $test_project = Clearcase::UCM::Project->new('tc.project', $test_folder, $test_pvob); $test_project->remove if $test_project->exists; - + $log->msg('Creating UCM Project tc.project'); my ($status, @output) = $test_project->create; @@ -862,7 +764,6 @@ sub RunUCMTests() { $status += CreateUCMIntStream; $status += CreateUCMDevStream; $status += CreateUCMIntView; - $status += SetupAttributeTypes; $status += CreateUCMDevView; $status += CreateUCMComponent; $status += AddModifiableComponent; @@ -883,18 +784,8 @@ my $startTime = time; my $conf_file = "$FindBin::Bin/$script.conf"; my $status = 0; -$opts{help} = sub { pod2usage }; -$opts{usage} = sub { pod2usage (-verbose => 2)}; -$opts{base} = 1; -$opts{clean} = 1; -$opts{username} = $ENV{CQ_USERNAME}; -$opts{password} = $ENV{CQ_PASSWORD}; -$opts{weburl} = $ENV{CQ_WEBURL}; - -$opts{weburl} .= $opts{weburl} ? "/oslc" : undef; -$opts{database} = $ENV{CQ_DATABASE}; -$opts{dbset} = $ENV{CQ_DBSET}; -$opts{provider} = $ENV{CQ_PROVIDER} || 'CQPROV'; +$opts{base} = 1; +$opts{clean} = 1; GetOptions( \%opts, @@ -905,11 +796,7 @@ GetOptions( 'base!', 'ucm!', 'clean!', - 'username=s', - 'database=s', - 'dbset=s', - 'provider', -) || pod2usage; +) or Usage; # Read the config file if (-f $conf_file) { @@ -923,13 +810,6 @@ for (keys %default_opts) { $opts{$_} = $default_opts{$_} if !$opts{$_}; } # for -# Check CQ parameters -if ($opts{ucm}) { - for ('username', 'password', 'weburl', 'database', 'dbset', 'provider') { - pod2usage "In UCM mode you must specify -$_" unless $opts{$_}; - } # for -} # if - $log->msg("$script: Start"); LogOpts; @@ -937,12 +817,10 @@ LogOpts; # Since we are creating private vobs (to avoid complications with having to # know and code the registry password when making public vobs), we'll simply # change $Clearcase::VOBTAG_PREFIX -if ($ARCHITECTURE !~ /win/i) { - $Clearcase::VOBTAG_PREFIX = $ENV{TMP} . '/' || '/tmp'; -} # if +$Clearcase::VOBTAG_PREFIX = $ENV{TMP} || '/tmp'; if ($opts{base}) { - $status = SetupTest "${Clearcase::VOBTAG_PREFIX}tc.vob", 'tc.view'; + $status = SetupTest "$Clearcase::VOBTAG_PREFIX/tc.vob", 'tc.view'; if ($status == 0) { $status += RunTests; @@ -951,7 +829,7 @@ if ($opts{base}) { } # if # Note if we are doing UCM tests then we need the view and vob here... - $status += Cleanup($test_view, $test_vob) if $opts{clean} && !$opts{ucm}; + $status += Cleanup($test_view, $test_vob) if $opts{clean} and !$opts{ucm}; if ($status != 0) { $log->err("$script: Failed (Base Clearcase)"); @@ -1007,9 +885,11 @@ L L +L + =head2 ClearSCM Perl Modules -=begin man +=begin man Clearcase Clearcase::Element diff --git a/test/testclearquest.pl b/test/testclearquest.pl index df33056..571d9f5 100755 --- a/test/testclearquest.pl +++ b/test/testclearquest.pl @@ -313,7 +313,7 @@ sub CreateWOR() { RCLC_name => 'Test RCLC', Prod_Arch1 => 'testcode : N/A', work_product_name => '10 - Software', - #Engr_target => 'Test Engineering Target', + Engr_target => 'Test Engineering Target', work_code_name => 'RAN-RW2', ); @@ -502,7 +502,7 @@ DeleteRecord 'Component', $FindBin::Script if $opts{add}; $log->msg('Enable tc.project for integration with Clearquest'); -$test_pvob = Clearcase::UCM::Pvob->new("${Clearcase::VOBTAG_PREFIX}tc.pvob"); +$test_pvob = Clearcase::UCM::Pvob->new("${Clearcase::VOBTAG_PREFIX}/tc.pvob"); $test_project = Clearcase::UCM::Project->new('tc.project', 'tc.folder', $test_pvob); my ($rc, @output) = $test_project->change("-force -crmenable $opts{CQ_DATABASE}"); -- 2.17.1