ClearCase-Wrapper
view release on metacpan or search on metacpan
package ClearCase::Wrapper;
$VERSION = '1.19';
require 5.006;
use AutoLoader 'AUTOLOAD';
use B;
use strict;
use warnings;
use vars qw(%Packages %ExtMap $libdir $prog $dieexit $dieexec $diemexec);
# Inherit some symbols from the main package. We will later "donate"
# these to all overlay packages as well.
BEGIN {
*prog = \$::prog;
*dieexit = \$::dieexit;
*dieexec = \$::dieexec;
*diemexec = \$::diemexec;
}
# For some reason this can't be handled the same as $prog above ...
use constant MSWIN => $^O =~ /MSWin|Windows_NT/i ? 1 : 0;
# This is the list of functions we want to export to overlay pkgs.
my @exports = qw(MSWIN GetOptions Assert Burrow Msg Pred ViewTag
AutoCheckedOut AutoNotCheckedOut AutoViewPrivate);
# Hacks for portability with Windows env vars.
BEGIN {
$ENV{LOGNAME} ||= $ENV{USERNAME};
$ENV{HOME} ||= "$ENV{HOMEDRIVE}/$ENV{HOMEPATH}";
}
# Unless the user has their own CLEARCASE_PROFILE, set it to the global one.
BEGIN {
# Learn where this module was found so we can look there for other files.
($libdir = $INC{'ClearCase/Wrapper.pm'}) =~ s%\.pm$%%;
if (defined $ENV{CLEARCASE_PROFILE}) {
$ENV{_CLEARCASE_WRAPPER_PROFILE} = $ENV{CLEARCASE_PROFILE};
} elsif ($ENV{_CLEARCASE_WRAPPER_PROFILE}) {
$ENV{CLEARCASE_PROFILE} = $ENV{_CLEARCASE_WRAPPER_PROFILE};
} elsif (! -f "$ENV{HOME}/.clearcase_profile") {
my $rc = join('/', $libdir, 'clearcase_profile');
$ENV{CLEARCASE_PROFILE} = $rc if -r $rc;
}
}
# Skip the Getopt::Long->import(), we need our own GetOptions().
require Getopt::Long;
# Getopt::Long::GetOptions() respects '--' but strips it, while
# we want to respect '--' and leave it in. Thus this override.
sub GetOptions {
@ARGV = map {/^--$/ ? qw(=--= --) : $_} @ARGV;
my $ret = Getopt::Long::GetOptions(@_);
@ARGV = map {/^=--=$/ ? qw(--) : $_} @ARGV;
return $ret;
}
# Technically we should use Getopt::Long::Configure() for these but
# there's a tangled version history and this is faster anyway.
$Getopt::Long::passthrough = 1; # required for wrapper programs
$Getopt::Long::ignorecase = 0; # global override for dumb default
# Any subroutine declared in a module located via this code
# will eclipse one of the same name declared above.
## NOTE: functions defined in modules found here should not
## be placed directly into ClearCase::Wrapper. They MUST be
## placed in the standard package analogous to their pathname
## (e.g. ClearCase::Wrapper::Foo). Magic occurs here to get
## them into ClearCase::Wrapper where they belong.
sub _FindAndLoadModules {
my ($dir, $subdir) = @_;
# Not sure how glob() sorts so force a standard order.
my @pms = sort glob("$dir/$subdir/*.pm");
for my $pm (@pms) {
my $dirQuoted = quotemeta($dir);
$pm =~ s%^$dirQuoted/(.*)\.pm$%$1%;
(my $pkg = $pm) =~ s%[/\\]+%::%g;
eval "*${pkg}::exit = \$dieexit";
eval "*${pkg}::exec = \$dieexec";
# In this block we temporarily enter the overlay's package
# just in case the overlay module forgot its package stmt.
# We then require the overlay file and also, if it's
# an autoloaded module (which is recommended), we drag
# in the index file too. This is because we need to
# derive a list of all functions defined in the overlay
# in order to import them to our own namespace.
{
eval qq(package $pkg); # default the pkg correctly
no warnings qw(redefine);
eval {
eval "require $pkg";
warn $@ if $@;
};
next if $@;
my $ix = "auto/$pm/autosplit.ix";
if (-e "$dir/$ix") {
eval { require $ix };
warn $@ if $@;
}
}
# Now the overlay module is read in. We need to examine its
# newly-created symbol table, determine which functions
# it defined, and import them here. The same basic thing is
# done for the base package later.
no strict 'refs';
my %names = %{"${pkg}::"};
for (keys %names) {
# Skip symbols that can't be names of valid cleartool ops.
next if m%^(?:_?[A-Z]|__|[ab]$)%;
my $tglob = "${pkg}::$_";
my $coderef = \&{$tglob};
next unless ref $coderef;
my $cv = B::svref_2object($coderef);
next unless $cv->isa('B::CV');
next if $cv->GV->isa('B::SPECIAL');
my $p = $cv->GV->STASH->NAME;
next unless $p eq $pkg;
# Take what survives the above tests and create a hash
# mapping defined functions to the pkg that defines them.
$ExtMap{$_} = $pkg;
# We import the entire typeglob for 'foo' when we
# find an extension func named foo(). This allows usage
# msg extensions (in the form $foo) to come over too.
eval qq(*$_ = *$tglob);
}
# The base module defines a few functions which the
# overlay's code might want to use. Make aliases
# for those in the overlay's symbol table.
for (@exports) {
eval "*${pkg}::$_ = \\&$_";
}
eval "*${pkg}::prog = \\\$prog";
$Packages{$pkg} = $INC{"$pm.pm"};
}
}
for my $subdir (qw(ClearCase/Wrapper ClearCase/Wrapper/Site)) {
for my $dir (@INC) {
_FindAndLoadModules($dir, $subdir);
}
}
$Packages{'ClearCase::Wrapper'} = __FILE__;
# Piggyback on the -ver flag to show our version too.
if (@ARGV && $ARGV[0] =~ /^-ver/i) {
my $fmt = "*%-32s %s (%s)\n";
local $| = 1;
for (sort keys %Packages) {
my $ver = eval "\$$_\::VERSION" || '????';
my $mtime = localtime((stat $Packages{$_})[9]);
printf $fmt, $_, $ver, $mtime || '----';
}
exit 0 if $ARGV[0] =~ /^-verw/i;
}
# Take a string and an array, return the index of the 1st occurrence
# of the string in the array.
sub _FirstIndex {
my $flag = shift;
for my $i (0..$#_) {
return $i if $flag eq $_[$i];
}
return undef;
}
# Implements the -me -tag convention (see POD).
if (my $me = _FirstIndex('-me', @ARGV)) {
if ($ARGV[0] =~ /^(?:set|start|end)view$|^rdl$|^work/) {
my $delim = 0;
for (@ARGV) {
last if /^--$/;
$delim++;
}
for (reverse @ARGV[0..$delim-1]) {
if (/^\w+$/) {
$_ = join('_', $ENV{LOGNAME}, $_);
last;
}
}
splice(@ARGV, $me, 1);
} elsif (my $tag = _FirstIndex('-tag', @ARGV)) {
$ARGV[$tag+1] = join('_', $ENV{LOGNAME}, $ARGV[$tag+1]);
splice(@ARGV, $me, 1);
}
}
# Implements the -M flag (see POD).
# Return the list of view-private files according to the
# -dir/-rec/-all/-avobs flags. Passes the supplied args to
# ct lsp and massages the result. The first param is a boolean
# indicating whether to give the user an "ok to proceed?"
# prompt; this function may exit if the answer is no.
sub AutoViewPrivate {
my($ok, $do, $scope, $parents, $screen) = @_;
my @vps;
# Can't use lsprivate in a snapshot view ...
if (-e '.@@/main/0') {
my $lsp = Argv->new([$^X, '-S', $0, 'lsp'], [qw(-s -oth), $scope]);
$lsp->opts($lsp->opts, '-do') if $do;
chomp(@vps = $lsp->qx);
} else {
require File::Spec;
File::Spec->VERSION(0.82);
die Msg('E', "-do flag not supported in snapshot views") if $do;
die Msg('E', "$scope flag not supported in snapshot views")
if $scope =~ /^-a/;
my $ls = ClearCase::Argv->ls([qw(-s -view -vis)]);
$ls->opts($ls->opts, $scope) if $scope =~ /^-r/;
chomp(@vps = $ls->qx);
@vps = map {File::Spec->rel2abs($_)} @vps;
}
if (MSWIN) {
for (@vps) { s%\\%/%g }
}
# Some v-p files we may not be interested in ...
@vps = grep !m%$screen%, @vps if $screen;
@vps = sort @vps;
if ($parents && @vps && $scope =~ /^-(dir|rec)/) {
# In case the command was run in a v-p directory, traverse upwards
# towards the vob root adding parent directories till we reach
# a versioned dir.
require Cwd;
my $ctls = ClearCase::Argv->ls({autofail=>1}, [qw(-d -s -vob)], '.');
while (! $ctls->qx) {
unshift(@vps, Cwd::getcwd());
$vps[0] =~ s%\\%/%g if MSWIN;
if (! Cwd::chdir('..')) {
my $err = "$!";
die Msg('E', Cwd::getcwd() . ": $err");
}
}
}
_ShowFound($ok, @vps); # may exit
exit 0 unless @vps;
return @vps;
}
=head1 CLEARTOOL ENHANCEMENTS
=over 4
=item * EXTENSIONS
A pseudo-command which lists the currently-defined extensions. Use with
B<-long> to see which overlay module defines each extension. Note that
both extensions and their aliases (e.g. I<checkin> and I<ci>) are
shown.
=cut
sub extensions {
my %opt;
GetOptions(\%opt, qw(short long));
my @exts = sort grep !/^_/, keys %ExtMap;
for (@exts) {
print "$ExtMap{$_}::" if $opt{long};
print $_, "\n";
}
exit 0;
}
=item * CI/CHECKIN
Extended to handle the B<-dir/-rec/-all/-avobs> flags. These are fairly
self-explanatory but for the record B<-dir> checks in all checkouts in
the current directory, B<-rec> does the same but recursively down from
the current directory, B<-all> operates on all checkouts in the current
VOB, and B<-avobs> on all checkouts in any VOB.
Extended to allow B<symbolic links> to be checked in (by operating on
the target of the link instead).
Extended to implement a B<-diff> flag, which runs a B<I<diff -pred>>
command before each checkin so the user can review his/her changes
before typing the comment.
Implements a new B<-revert> flag. This causes identical (unchanged)
elements to be unchecked-out instead of being checked in.
Implements a new B<-mkhlink> flag. This works in the context of the
B<-revert> flag and causes any inbound merge hyperlinks to an unchanged
checked-out element to be copied to its predecessor before the unchanged
element is unchecked-out.
Since checkin is such a common operation a special feature is supported
to save typing: an unadorned I<ci> cmd is C<promoted> to I<ci -dir -me
-diff -revert>. In other words typing I<ct ci> will step through each
file checked out by you in the current directory and view,
automatically undoing the checkout if no changes have been made and
showing diffs followed by a checkin-comment prompt otherwise.
=cut
sub checkin {
# Allows 'ct ci' to be shorthand for 'ct ci -me -diff -revert -dir'.
push(@ARGV, qw(-me -diff -revert -dir)) if grep(!/^-pti/, @ARGV) == 1;
# -re999 isn't a real flag, it's to disambiguate -rec from -rev
# Same for -cr999.
my %opt;
GetOptions(\%opt, qw(crnum=s cr999=s diff ok revert re999 mkhlink mk999))
if grep /^-(crn|dif|ok|rev|mkh)/, @ARGV;
die Msg('E', "-mkhlink flag requires -revert flag")
if ($opt{mkhlink} && ! $opt{revert});
=over 4
=item * symlink expansion
Before processing a checkin or checkout command, any symbolic links on
the command line are replaced with the file they point to. This allows
developers to operate directly on symlinks for ci/co.
=item * -M flag
As a convenience feature, the B<-M> flag runs all output through your
pager. Of course C<"ct lsh -M foo"> saves only a few keystrokes over
"ct lsh foo | more" but for heavy users of shell history the more
important feature is that it preserves the value of ESC-_ (C<ksh -o
vi>) or !$ (csh). The CLEARCASE_WRAPPER_PAGER EV has the same effect.
This may not work on Windows, though it's possible that a sufficiently
modern Perl build and a smarter pager than I<more.com> will do the
trick.
=item * -P flag
The special B<-P> flag will cause C<ct> to I<pause> before finishing.
On Windows this means running the built in C<pause> command. This flag
is useful for plugging I<ClearCase::Wrapper> scripts into the CC GUI.
=item * -me -tag
Introduces a global convenience/standardization feature: the flag
B<-me> in the context of a command which takes a B<-tag view-tag>
causes I<"$LOGNAME"> to be prefixed to the tag name with an
underscore. This relies on the fact that even though B<-me> is a
native cleartool flag, at least through CC 7.0 no command which takes
B<-tag> also takes B<-me> natively. For example:
% <wrapper-context> mkview -me -tag myview ...
The commands I<setview, startview, endview, and lsview> also take B<-me>,
such that the following commands are equivalent:
% <wrapper-context> setview dboyce_myview
% <wrapper-context> setview -me myview
=back
=head1 CONFIGURABILITY
Various degrees of configurability are supported:
=over 4
=item * Global Enhancements and Extensions
To add a global override called 'cleartool xxx', you could just write a
subroutine 'xxx', place it after the __END__ token in Wrapper.pm, and
re-run 'make install'. However, these changes wcould be lost when a new
version of ClearCase::Wrapper is released, and you'd have to take
responsibility for merging your changes with mine.
Therefore, the preferred way to make site-wide customizations or
additions is to make an I<overlay> module. ClearCase::Wrapper will
automatically include ('require') all modules in the
ClearCase::Wrapper::* subclass. Thus, if you work for C<TLA
Corporation> you should put your enhancement subroutines in a module
called ClearCase::Wrapper::TLA and they'll automatically become
available.
A sample overlay module is provided in the C<./examples> subdir. To
make your own you need only take this sample, change all uses of the
word 'MySite' to a string of your choice, replace the sample subroutine
C<mysite()> with your own, and install. It's a good idea to document
your extension in POD format right above the sub and make the
appropriate addition to the "Usage Message Extensions" section. Also,
if the command has an abbreviation (e.g. checkout/co) you should add
that to the "Command Aliases" section. See ClearCase::Wrapper::DSB
for examples.
Two separate namespaces are recognized for overlays:
I<ClearCase::Wrapper::*> and I<ClearCase::Wrapper::Site::*>. The intent
is that if your extension is site-specific it should go in the latter
area, if of general use in the former. These may be combined. For
instance, imagine TLA Corporation is a giant international company with
many sites using ClearCase, and your site is known as R85G. There could
be a I<ClearCase::Wrapper::TLA> overlay with enhancements that apply
anywhere within TLA and/or a I<ClearCase::Wrapper::Site::R85G> for
your people only. Note that since overlay modules in the Site namespace
are not expected to be published on CPAN the naming rules can be less
strict, which is why C<TLA> was left out of the latter module name.
Overlays in the general I<ClearCase::Wrapper::*> namespace are
traversed before I<ClearCase::Wrapper::Site::*>. This allows
site-specific configuration to override more general code. Within each
namespace modules are read in standard ASCII sorted alphabetical
order.
All override subroutines are called with @ARGV as their parameter list
(and @ARGV is also available directly of course). The function can do
whatever it likes but it's recommended that I<ClearCase::Argv> be used
to run any cleartool subcommands, and its base class I<Argv> be used to
run other programs. These modules help with UNIX/Windows portability
and debugging, and aid in parsing flags into different categories where
required. See their PODs for full documentation, and see the supplied
extensions for lots of examples.
=item * Personal Preference Setting
As well as allowing for site-wide enhancements to be made in
Wrapper.pm, a hook is also provided for individual users to set their
own defaults. If the file C<~/.clearcase_profile.pl> exists it will be
read before launching any of the sitewide enhancements. Note that this
file is passed to the Perl interpreter and thus has access to the full
array of Perl syntax. This mechanism is powerful but the corollary is
that users must be experienced with both ClearCase and Perl, and to
some degree with the ClearCase::Wrapper module, to use it. Here's an
example:
% cat ~/.clearcase_profile.pl
require ClearCase::Argv;
Argv->dbglevel(1);
ClearCase::Argv->ipc(2);
The purpose of the above is to turn on ClearCase::Argv "IPC mode"
for all commands. The verbosity (Argv->dbglevel) is only set to
demonstrate that the setting works. The require statement is used
to ensure that the module is loaded before we attempt to configure it.
=item * Sitewide ClearCase Comment Defaults
This distribution comes with a file called I<clearcase_profile> which
is installed as part of the module. If the user has no
I<clearcase_profile> file in his/her home directory and if
CLEARCASE_PROFILE isn't already set, CLEARCASE_PROFILE will
automatically be pointed at this supplied file. This allows the
administrator to set sitewide defaults of checkin/checkout comment
handling using the syntax supported by ClearCase natively but without
each user needing to maintain their own config file or set their own
EV.
=item * CLEARCASE_WRAPPER_NATIVE
This environment variable may be set to suppress all extensions,
causing the wrapper to behave just like an alias to cleartool, though
somewhat slower.
=back
( run in 0.789 second using v1.01-cache-2.11-cpan-437f7b0c052 )