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 = '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:\\IBMRational\\RationalSDLC\\Clearcase';
123 $CCHOME = 'D:\\IBMRational\\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/ 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`;
598 return (-1, 'Clearcase not installed')
601 $clearpid = open3 ($clearin, $clearout, $clearout, $cleartool, "-status");
603 return (-1, ('Clearcase not installed')) unless $clearpid;
607 print $clearin "$cmd\n";
609 # Now read output from $clearout and format the lines in to an array. Also
610 # capture the status code to return it.
611 while (my $line = <$clearout>) {
612 if ($line !~ /(.*)Command \d+ returned status (\d+)/sm) {
623 chop @output if $output[0] =~ /\r$/;
626 # We're getting extra blank lines at the bottom of @output. Not sure why
627 # but we need to remove it
629 if @output and $output[$#output] eq '';
631 $self->{lastcmd} = 'cleartool ' . $cmd;
632 $self->{status} = $status;
633 $self->{output} = join "\n", @output;
635 return ($status, @output);
645 Return last command attempted by execute
649 =for html <blockquote>
657 =for html </blockquote>
661 =for html <blockquote>
665 =item Last command attempted by execute
669 =for html </blockquote>
673 $self->{lastcmd} ||= '';
675 return $self->{lastcmd};
685 Construct a new Clearcase object. Note there is already a default
686 Clearcase object created named $cc. You should use that unless you
687 have good reason to instantiate another Clearcase object.
691 =for html <blockquote>
699 =for html </blockquote>
703 =for html <blockquote>
707 =item Clearcase object
711 =for html </blockquote>
723 registry_host => $registry_host,
726 vobtag_prefix => $VOBTAG_PREFIX,
727 viewtag_prefix => $VIEWTAG_PREFIX,
728 regions => \@regions,
731 # Get list of regions
732 my ($status, @output);
734 ($status, @regions) = $self->execute ('lsregion');
739 # Get hostinfo attributes
740 ($status, @output) = $self->execute ('hostinfo -long');
746 if (/Client: (.*)/) {
747 $self->{client} = lc $1;
748 } elsif (/Product: (.*)/) {
749 $self->{version} = $1;
750 } elsif (/Operating system: (.*)/) {
752 } elsif (/Hardware type: (.*)/) {
753 $self->{hardware_type} = $1;
754 } elsif (/Registry host: (.*)/) {
755 $self->{registry_host} = $1;
756 } elsif (/Registry region: (.*)/) {
757 $self->{region} = $1;
758 $self->{sitename} = $1;
760 if ($self->{region} =~ /(\S*)(NT|UNIX)$/) {
761 $self->{sitename} = $1;
763 } elsif (/License host: (.*)/) {
764 $self->{license_host} = $1;
771 # Member access methods...
784 =for html <blockquote>
792 =for html </blockquote>
796 =for html <blockquote>
804 =for html </blockquote>
808 return $self->{client};
818 Returns the hardware_type
822 =for html <blockquote>
830 =for html </blockquote>
834 =for html <blockquote>
842 =for html </blockquote>
846 return $self->{hardware_type};
856 Returns the license_host
860 =for html <blockquote>
868 =for html </blockquote>
872 =for html <blockquote>
880 =for html </blockquote>
884 return $self->{license_host};
898 =for html <blockquote>
906 =for html </blockquote>
910 =for html <blockquote>
918 =for html </blockquote>
936 =for html <blockquote>
944 =for html </blockquote>
948 =for html <blockquote>
956 =for html </blockquote>
960 return $self->{region};
970 Returns the registry_host
974 =for html <blockquote>
982 =for html </blockquote>
986 =for html <blockquote>
994 =for html </blockquote>
998 return $self->{registry_host};
1008 Returns the sitename
1012 =for html <blockquote>
1020 =for html </blockquote>
1024 =for html <blockquote>
1032 =for html </blockquote>
1036 return $self->{sitename};
1050 =for html <blockquote>
1058 =for html </blockquote>
1062 =for html <blockquote>
1070 =for html </blockquote>
1074 return $self->{version};
1084 Returns an array of regions in an array context or the number of
1085 regions in a scalar context
1089 =for html <blockquote>
1097 =for html </blockquote>
1101 =for html <blockquote>
1105 =item array of regions or number of regions
1109 =for html </blockquote>
1114 my @returnArray = sort @{$self->{regions}};
1116 return @returnArray;
1118 return scalar @{$self->{regions}};
1129 Returns the current working view or undef if not in a view
1133 =for html <blockquote>
1141 =for html </blockquote>
1145 =for html <blockquote>
1149 =item Current working view or undef if none
1153 =for html </blockquote>
1157 my ($status, @output) = $self->execute ('pwv -short');
1160 return $output[0] eq '** NONE **' ? undef : $output[0];
1163 sub name2oid ($;$) {
1164 my ($self, $name, $vob) = @_;
1170 Returns the oid for a given name
1174 =for html <blockquote>
1180 The name to convert (unless filesystem object it should contain a type:)
1184 The vob the name belongs to
1188 =for html </blockquote>
1192 =for html <blockquote>
1200 =for html </blockquote>
1205 $vob = '@' . vobtag $vob;
1210 my ($status, @output) = $self->execute ("dump $name$vob");
1214 @output = grep { /^oid=/ } @output;
1216 if ($output[0] =~ /oid=(\S+)\s+/) {
1224 my ($self, $oid, $vob) = @_;
1230 Returns the object name for the given oid
1234 =for html <blockquote>
1244 The vob the OID belongs to
1248 =for html </blockquote>
1252 =for html <blockquote>
1256 =item String representing the OID's textual name/value
1260 =for html </blockquote>
1265 unless $vob =~ /^vobuuid:/;
1267 my ($status, @output) = $self->execute (
1268 "describe -fmt \"%n\" oid:$oid\@$vob"
1280 =head2 verbose_level
1282 Returns the verbose_level
1286 =for html <blockquote>
1294 =for html </blockquote>
1298 =for html <blockquote>
1306 =for html </blockquote>
1310 return $self->{verbose_level};
1320 Sets verbose_level to quiet
1324 =for html <blockquote>
1332 =for html </blockquote>
1336 =for html <blockquote>
1344 =for html </blockquote>
1348 $self->{verbose_level} = 0;
1360 Sets verbose_level to noisy
1364 =for html <blockquote>
1372 =for html </blockquote>
1376 =for html <blockquote>
1384 =for html </blockquote>
1388 $self->{verbose_level} = 1;
1393 $CC = Clearcase->new;
1403 L<IPC::Open3|IPC::Open3>
1405 =head2 ClearSCM Perl Modules
1407 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1409 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSdep</a></p>
1411 =head1 BUGS AND LIMITATIONS
1413 There are no known bugs in this module
1415 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1417 =head1 LICENSE AND COPYRIGHT
1419 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.