3 =head1 NAME $RCSfile: Clearcase.pm,v $
5 Object oriented interface to Clearcase.
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Tue Dec 4 17:33:43 MST 2007
25 $Date: 2011/11/16 18:27:37 $
31 Provides access to global Clearcase information in an object oriented manner as
32 well as an interface to cleartool.
34 # Access some compile time global settings:
35 display "View Drive: $Clearcase::VIEW_DRIVE";
36 display "Vob Tag Prefix: $Clearcase::VOBTAG_PREFIX";
38 # Access some run time global information through the default object
39 display "Client: $Clearcase::CC->client";
40 display "Region: $Clearcase::CC->region";
41 display "Registry host: $Clearcase::CC->registry_host";
43 # List all vobs using execute method of the default object";
44 my ($status, @vobs) = $Clearcase::CC->execute ("lsvob -s");
46 display $_ foreach (@vobs) if $status == 0;
50 This module, and others below the Clearcase directory, implement an object
51 oriented approach to Clearcase. In general Clearcase entities are made into
52 objects that can be manipulated easily in Perl. This module is the main or
53 global module. Contained herein are members and methods of a general or global
54 nature. Also contained here is an IPC interface to cleartool such that cleartool
55 runs in the background and commands are fed to it via the execute method. When
56 making repeated calls to cleartool this can result in a substantial savings of
57 time as most operating systems' fork/execute sequence is time consuming. Factors
58 of 8 fold improvement have been measured.
60 Additionally a global variable, $CC, is implemented from this module such that
61 you should not need to instantiate another one, though you could.
65 The following routines are exported:
83 my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool);
85 our $VIEW_DRIVE = $ENV{CLEARCASE_VIEW_DRIVE} || 'M';
86 our $VOB_MOUNT = 'vob';
87 our $WIN_VOB_PREFIX = '\\';
88 our $SFX = $ENV{CLEARCASE_XN_SFX} ? $ENV{CLEARCASE_XN_SFX} : '@@';
90 our $VOBTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin')
93 our $VIEWTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin')
97 our ($CCHOME, $COUNTDB);
101 our @EXPORT_OK = qw (
114 # Find executables that we rely on
115 if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') {
116 # Should really go to the registry for this...
118 # We can go to the registry pretty easy in Cygwin but I'm not sure how to do
119 # that in plain old Windows. Most people either have Clearcase installed on
120 # the C drive or commonly on the D drive on servers. So we'll look at both.
121 $CCHOME = 'C:\\Program Files (x86)\\ibm\\RationalSDLC\\Clearcase';
123 $CCHOME = 'D:\\Program Files (x86)\\ibm\\RationalSDLC\\Clearcase'
126 error 'Unable to figure out where Clearcase is installed', 1
129 $COUNTDB = "$CCHOME\\etc\\utils\\countdb.exe";
131 $CCHOME = '/opt/rational/clearcase';
132 $COUNTDB = "$CCHOME/etc/utils/countdb";
135 #error "Unable to find countdb ($COUNTDB)", 2
143 # Exit cleartool process
144 print $clearin "exit\n";
146 waitpid $clearpid, 0;
149 local $? = $exitStatus;
151 # Call old signal handler (if any)
152 &$oldHandler if $oldHandler;
157 # Save old interrupt handler
158 $oldHandler = $SIG{INT};
160 # Set interrupt handler
161 local $SIG{INT} = \&Clearcase::DESTROY;
168 foreach (keys %opts) {
170 $opts .= "$opts{$_} "
177 sub _setComment ($) {
180 return !$comment ? '-nc' : '-c "' . quotemeta $comment . '"';
188 =head2 vobname ($tag)
190 Given a vob tag, return the vob name by stripping of the VOBTAG_PREFIX properly
191 such that you return just the unique vob name. This is tricky because Windows
192 uses '\' as a VOBTAG_PREFIX. With '\' in there regex's like
193 /$Clearcase::VOBTAG_PREFIX(.+)/ to capture the vob's name minus the
194 VOBTAG_PREFIX fail because Perl evaluates this as just a single '\', which
195 escapes the '(' of the '(.+)'!
199 =for html <blockquote>
213 =for html </blockquote>
217 =for html <blockquote>
225 The unique part of the vob name
231 =for html </blockquote>
237 # Special code because Windows $VOBTAG prefix (a \) is such a pain!
238 if (substr ($tag, 0, 1) eq '\\') {
239 $name = substr $tag, 1;
240 } elsif (substr ($tag, 0, 1) eq '/') {
241 if ($tag =~ /${Clearcase::VOBTAG_PREFIX}\/(.+)/) {
254 =head2 vobtag ($name)
256 Given a vob name, add the VOBTAG_PREFIX based on the current OS.
260 =for html <blockquote>
274 =for html </blockquote>
278 =for html <blockquote>
292 =for html </blockquote>
296 # If the $VOBTAG_PREFIX is already there then do nothing
297 if (substr ($name, 0, length $VOBTAG_PREFIX) eq $VOBTAG_PREFIX) {
300 return "$VOBTAG_PREFIX$name";
304 sub attributes ($$;%) {
305 # TODO: Need to handle other options too
306 my ($self, $type, $name, %newAttribs) = @_;
310 =head2 attributes ($type, $name)
312 Get any attributes attached to the $type:$name
316 =for html <blockquote>
324 Type of object to look for attributes. For example, activity, baseline, etc.
328 Object name to look for attributes.
334 =for html </blockquote>
338 =for html <blockquote>
346 Hash of attribute name/values
352 =for html </blockquote>
356 my $cmd = "describe -fmt \"%Na\" $type:$name";
358 my ($status, @output) = $CC->execute ($cmd);
366 my $attributes = $output[0];
369 while ($attributes ne '') {
370 if ($attributes =~ /^=(\"*)(.*)/) {
371 if ($2 =~ /(.*?)$1(\s|$)(.*)/) {
372 $attributes{$name} = $1;
375 $attributes{$name} = $2;
378 } elsif ($attributes =~ /^(\w+)=(.*)/) {
382 croak "Parsing error while parsing " . ref ($self) . " attributes";
387 # Set any %newAttribs
388 foreach (keys %newAttribs) {
389 # TODO: What about other options like -comment?
390 $cmd = "mkattr -replace -nc $_ \"";
391 $cmd .= quotemeta $newAttribs{$_};
392 $cmd .= "\" $type:$name";
397 die "Unable to execute $cmd (Status: "
398 . $CC->status . ")\n"
399 . join ("\n", $CC->output);
401 $attributes{$_} = $newAttribs{$_};
415 Returns the status of the last executed command.
419 =for html <blockquote>
431 =for html </blockquote>
435 =for html <blockquote>
443 Status of the command last executed.
449 =for html </blockquote>
453 return $self->{status};
463 Returns the output of the last executed command.
467 =for html <blockquote>
479 =for html </blockquote>
483 =for html <blockquote>
489 =item @output or $output
491 If called in a list context, returns @output, otherwise returns $output.
497 =for html </blockquote>
502 return split /\n/, $self->{output};
504 return $self->{output};
508 # TODO: Should implement a pipe call that essentially does a cleartool command
509 # to a pipe allowing the user to read from the pipe. This will help with such
510 # cleartool command that may give back huge output or where the user wishes to
511 # start processing the output as it comes instead of waiting until the cleartool
512 # command is completely finished. Would like to do something like execute does
513 # with cleartool running in the background but we need to handle the buffering
514 # of output sending only whole lines.
517 my ($self, $cmd) = @_;
521 =head2 execute ($cmd)
523 Sends a command to the cleartool coprocess. If not running a cleartool coprocess
524 is started and managed. The coprocess is implemented as a coprocess using IPC
525 for communication that will exist until the object is destroyed. Stdin and
526 stdout/stderr are therefore pipes and can be fed. The execute method feds the
527 input pipe and returns status and output from the output pipe.
529 Using execute can speed up execution of repeative cleartool invocations
534 =for html <blockquote>
542 Cleartool command to execute.
548 =for html </blockquote>
552 =for html <blockquote>
560 Status of the command last executed.
564 Array of output lines from the cleartool command execution.
570 =for html </blockquote>
574 my ($status, @output);
576 # This seems to be how most people locate cleartool. On Windows (this
577 # includes Cygwin) we assume it's in our path. On Unix/Linux we assume it's
578 # installed under /opt/rational/clearcase/bin. This is needed in case we wish
579 # to use these Clearcase objects say in a web page where the server is often
580 # run as a plain user who does not have cleartool in their path.
581 unless ($cleartool) {
582 if ($ARCHITECTURE =~ /Win/i or $ARCHITECTURE eq 'cygwin') {
583 $cleartool = 'cleartool';
584 } elsif (-x '/opt/rational/clearcase/bin/cleartool') {
585 $cleartool = '/opt/rational/clearcase/bin/cleartool';
589 # TODO: Need to catch SIGCHILD here in case the user does something like hit
590 # Ctrl-C. Such an action may interrupt the underlying cleartool process and
591 # kill it. But we would be unaware (i.e. $clearpid would still be set). So
592 # when SIGCHILD is caught we need to undef $clearpid.
594 # Simple check to see if we can execute cleartool
595 @output = `$cleartool -ver 2>&1`;
597 return (-1, 'Clearcase not installed')
600 $clearpid = open3 ($clearin, $clearout, $clearout, $cleartool, "-status");
602 return (-1, ('Clearcase not installed')) unless $clearpid;
606 print $clearin "$cmd\n";
608 # Now read output from $clearout and format the lines in to an array. Also
609 # capture the status code to return it.
610 while (my $line = <$clearout>) {
611 if ($line !~ /(.*)Command \d+ returned status (\d+)/sm) {
622 chop @output if $output[0] =~ /\r$/;
625 # We're getting extra blank lines at the bottom of @output. Not sure why
626 # but we need to remove it
628 if @output and $output[$#output] eq '';
630 $self->{lastcmd} = 'cleartool ' . $cmd;
631 $self->{status} = $status;
632 $self->{output} = join "\n", @output;
634 return ($status, @output);
644 Return last command attempted by execute
648 =for html <blockquote>
656 =for html </blockquote>
660 =for html <blockquote>
664 =item Last command attempted by execute
668 =for html </blockquote>
672 $self->{lastcmd} ||= '';
674 return $self->{lastcmd};
684 Construct a new Clearcase object. Note there is already a default
685 Clearcase object created named $cc. You should use that unless you
686 have good reason to instantiate another Clearcase object.
690 =for html <blockquote>
698 =for html </blockquote>
702 =for html <blockquote>
706 =item Clearcase object
710 =for html </blockquote>
722 registry_host => $registry_host,
725 vobtag_prefix => $VOBTAG_PREFIX,
726 viewtag_prefix => $VIEWTAG_PREFIX,
727 regions => \@regions,
730 # Get list of regions
731 my ($status, @output);
733 ($status, @regions) = $self->execute ('lsregion');
738 # Get hostinfo attributes
739 ($status, @output) = $self->execute ('hostinfo -long');
745 if (/Client: (.*)/) {
746 $self->{client} = lc $1;
747 } elsif (/Product: (.*)/) {
748 $self->{version} = $1;
749 } elsif (/Operating system: (.*)/) {
751 } elsif (/Hardware type: (.*)/) {
752 $self->{hardware_type} = $1;
753 } elsif (/Registry host: (.*)/) {
754 $self->{registry_host} = $1;
755 } elsif (/Registry region: (.*)/) {
756 $self->{region} = $1;
757 $self->{sitename} = $1;
759 if ($self->{region} =~ /(\S*)(NT|UNIX)$/) {
760 $self->{sitename} = $1;
762 } elsif (/License host: (.*)/) {
763 $self->{license_host} = $1;
770 # Member access methods...
783 =for html <blockquote>
791 =for html </blockquote>
795 =for html <blockquote>
803 =for html </blockquote>
807 return $self->{client};
817 Returns the hardware_type
821 =for html <blockquote>
829 =for html </blockquote>
833 =for html <blockquote>
841 =for html </blockquote>
845 return $self->{hardware_type};
855 Returns the license_host
859 =for html <blockquote>
867 =for html </blockquote>
871 =for html <blockquote>
879 =for html </blockquote>
883 return $self->{license_host};
897 =for html <blockquote>
905 =for html </blockquote>
909 =for html <blockquote>
917 =for html </blockquote>
935 =for html <blockquote>
943 =for html </blockquote>
947 =for html <blockquote>
955 =for html </blockquote>
959 return $self->{region};
969 Returns the registry_host
973 =for html <blockquote>
981 =for html </blockquote>
985 =for html <blockquote>
993 =for html </blockquote>
997 return $self->{registry_host};
1007 Returns the sitename
1011 =for html <blockquote>
1019 =for html </blockquote>
1023 =for html <blockquote>
1031 =for html </blockquote>
1035 return $self->{sitename};
1049 =for html <blockquote>
1057 =for html </blockquote>
1061 =for html <blockquote>
1069 =for html </blockquote>
1073 return $self->{version};
1083 Returns an array of regions in an array context or the number of
1084 regions in a scalar context
1088 =for html <blockquote>
1096 =for html </blockquote>
1100 =for html <blockquote>
1104 =item array of regions or number of regions
1108 =for html </blockquote>
1113 my @returnArray = sort @{$self->{regions}};
1115 return @returnArray;
1117 return scalar @{$self->{regions}};
1128 Returns the current working view or undef if not in a view
1132 =for html <blockquote>
1140 =for html </blockquote>
1144 =for html <blockquote>
1148 =item Current working view or undef if none
1152 =for html </blockquote>
1156 my ($status, @output) = $self->execute ('pwv -short');
1159 return $output[0] eq '** NONE **' ? undef : $output[0];
1162 sub name2oid ($;$) {
1163 my ($self, $name, $vob) = @_;
1169 Returns the oid for a given name
1173 =for html <blockquote>
1179 The name to convert (unless filesystem object it should contain a type:)
1183 The vob the name belongs to
1187 =for html </blockquote>
1191 =for html <blockquote>
1199 =for html </blockquote>
1204 $vob = '@' . vobtag $vob;
1209 my ($status, @output) = $self->execute ("dump $name$vob");
1213 @output = grep { /^oid=/ } @output;
1215 if ($output[0] =~ /oid=(\S+)\s+/) {
1223 my ($self, $oid, $vob) = @_;
1229 Returns the object name for the given oid
1233 =for html <blockquote>
1243 The vob the OID belongs to
1247 =for html </blockquote>
1251 =for html <blockquote>
1255 =item String representing the OID's textual name/value
1259 =for html </blockquote>
1264 unless $vob =~ /^vobuuid:/;
1266 my ($status, @output) = $self->execute (
1267 "describe -fmt \"%n\" oid:$oid\@$vob"
1279 =head2 verbose_level
1281 Returns the verbose_level
1285 =for html <blockquote>
1293 =for html </blockquote>
1297 =for html <blockquote>
1305 =for html </blockquote>
1309 return $self->{verbose_level};
1319 Sets verbose_level to quiet
1323 =for html <blockquote>
1331 =for html </blockquote>
1335 =for html <blockquote>
1343 =for html </blockquote>
1347 $self->{verbose_level} = 0;
1359 Sets verbose_level to noisy
1363 =for html <blockquote>
1371 =for html </blockquote>
1375 =for html <blockquote>
1383 =for html </blockquote>
1387 $self->{verbose_level} = 1;
1392 $CC = Clearcase->new;
1402 L<IPC::Open3|IPC::Open3>
1404 =head2 ClearSCM Perl Modules
1406 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1408 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSdep</a></p>
1410 =head1 BUGS AND LIMITATIONS
1412 There are no known bugs in this module
1414 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1416 =head1 LICENSE AND COPYRIGHT
1418 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.