view release on metacpan or  search on metacpan

DSB.pm  view on Meta::CPAN

package ClearCase::Wrapper::DSB;

$VERSION = '1.14';

use AutoLoader 'AUTOLOAD';

use strict;

#############################################################################
# Usage Message Extensions
#############################################################################
{
   local $^W = 0;
   no strict 'vars';

   # Usage message additions for actual cleartool commands that we extend.
   $catcs	= "\n* [-cmnt|-expand|-sources|-start]";
   $describe	= "\n* [--par/ents <n>]";
   $lock	= "\n* [-allow|-deny login-name[,...]] [-iflocked]";
   $lsregion	= "\n* [-current]";
   $mklabel	= "\n* [-up]";
   $setcs	= "\n* [-clone view-tag] [-expand] [-sync|-needed]";
   $setview	= "\n* [-me] [-drive drive:] [-persistent]";
   $update	= "\n* [-quiet]";
   $winkin	= "\n* [-vp] [-tag view-tag]";

   # Usage messages for pseudo cleartool commands that we implement here.
   # Note: we used to localize $0 but that turns out to trigger a bug
   # in perl 5.6.1.
   my $z = (($ARGV[0] eq 'help') ? $ARGV[1] : $ARGV[0]) || '';
   $comment	= "$z [-new] [-element] object-selector ...";
   $diffcs	= "$z view-tag-1 [view-tag-2]";
   $eclipse	= "$z element ...";
   $edattr	= "$z [-view [-tag view-tag]] | [-element] object-selector ...";
   $grep	= "$z [grep-flags] pattern element";
   $protectview	= "$z [-force] [-replace]"
		.  "\n[-chown login-name] [-chgrp group-name] [-chmod permissions]"
		.  "\n[-add_group group-name[,...]]"
		.  "\n[-delete_group group-name[,...]]"
		.  "\n{-tag view-tag | view-storage-dir-pname ...}";
   $recheckout	= "$z [-keep|-rm] pname ...";
   $winkout	= "$z [-dir|-rec|-all] [-f file] [-pro/mote] [-do]"
		.  "\n[-meta file [-print] file ...";
   $workon	= "$z [-me] [-login] [-exec command-invocation] view-tag";
}

#############################################################################
# Command Aliases
#############################################################################
*des		= *describe;
*desc		= *describe;
*edcmnt		= *comment;
*egrep		= *grep;
*mkbrtype	= *mklbtype;	# not synonyms but the code's the same
*reco		= *recheckout;
*work		= *workon;

1;

__END__

=head1 NAME

ClearCase::Wrapper::DSB - David Boyce's contributed cleartool wrapper functions

=head1 SYNOPSIS

This is an C<overlay module> for B<ClearCase::Wrapper> containing David
Boyce's non-standard extensions. See C<perldoc ClearCase::Wrapper> for
more details.

=head1 CLEARTOOL ENHANCEMENTS

=over 4

=item * CATCS

=over 4

=item 1. New B<-expand> flag

Follows all include statements recursively in order to print a complete
config spec. When used with the B<-cmnt> flag, comments are stripped
from this listing.

=item 2. New B<-sources> flag

Prints all files involved in the config spec (the I<config_spec> file
itself plus any files it includes).

=item 3. New B<-attribute> flag

This introduces the concept of user-defined I<view attributes>. A view
attribute is a keyword-value pair embedded in the config spec using the
conventional notation

    ##:Keyword: value ...

DSB.pm  view on Meta::CPAN

I</> are normalized to I<\> so they'll match the registry, and an
extension is made to allow multiple VOB tags to be passed to one
I<mount> command.

=cut

sub mount {
    return 0 if !MSWIN || @ARGV < 2;
    my %opt;
    GetOptions(\%opt, qw(all));
    my $mount = ClearCase::Argv->new(@ARGV);
    $mount->autofail(1);
    $mount->parse(qw(persistent options=s));
    die Msg('E', qq(Extra arguments: "@{[$mount->args]}"))
						if $mount->args && $opt{all};
    my @tags = $mount->args;
    my $lsvob = ClearCase::Argv->lsvob(@tags);
    # The set of all known public VOBs.
    my @public = grep /\spublic\b/, $lsvob->qx;
    # The subset which are not mounted.
    my @todo = map {(split /\s+/)[1]} grep /^\s/, @public;
    # If no vobs are mounted, let the native mount -all proceed.
    if ($opt{all} && @public == @todo) {
	push(@ARGV, '-all');
	return 0;
    }
    # Otherwise mount what's needed one by one.
    for (@todo) {
	$mount->args($_)->system;
    }
    exit 0;
}

=item * PROTECTVIEW

Modifies user or group permissions for one or more views.
Analogous to the native ClearCase command I<protectvob> (see).
Most flags accepted by B<protectview> behave similarly to those
of I<protectvob>.

The B<-replace> flag is special; it uses the administrative I<fix_prot>
tool to completely replace any pre-existing identity information. This
gives the view's permissions a "clean start"; in particular, any grants
of access to other groups will be removed.

This operation will not work on a running view. Views must be
manually stopped with C<endview -server> before reprotection may proceed.

B<Warning>: this is an experimental interface which has not been tested
in all scenarios. It cannot destroy any data, so there's nothing it
could break which could't be fixed with an administrator's help, but it
should still be used with care.  In particular, it's possible to
specify values to B<-chmod> which will confuse the view greatly.

=cut

sub protectview {
    die Msg('E', "not yet supported on Windows") if MSWIN;
    my %opt;
    GetOptions(\%opt, qw(force replace tag=s add_group=s delete_group=s
				    chown=s chgrp=s chmod=s));
    my $cmd = shift @ARGV;
    if ($opt{tag}) {
	Assert(@ARGV == 0);	# -tag and vws area are mutually exclusive
	my($vws) = (split ' ', ClearCase::Argv->lsview($opt{tag})->qx)[-1];
	push(@ARGV, $vws);
    }
    Assert(@ARGV > 0);	# die with usage msg if no vws area specified
    Assert(scalar %opt, 'no options specified');
    die Msg('E', "$cmd -chown requires administrative privileges")
						    if $opt{chown} && $> != 0;
    my $rc = 0;
    for my $vws (@ARGV) {
	my $idedir = "$vws/.identity";
	if (! -f "$vws/config_spec" || ! -d $idedir) {
	    warn Msg('W', "not a view storage area: $vws");
	    $rc = 1;
	    next;
	}
	if (! $opt{force}) {
	    my $prompt = qq(Protect view "$vws"?);
	    require ClearCase::ClearPrompt;
	    next if ClearCase::ClearPrompt::clearprompt(
			    qw(yes_no -def n -type ok -pro), $prompt);
	}
	if (-e "$vws/.pid") {
	    if ($opt{force}) {
		my $tag = $opt{tag};
		$tag ||= ClearCase::Argv->lsview([qw(-s -storage)], $vws)->qx;
		chomp $tag;
		ClearCase::Argv->endview([qw(-server)], $tag)->system;
	    }
	    if (-e "$vws/.pid") {
		warn Msg('W', "cannot protect running view $vws");
		$rc = 1;
		next;
	    }
	}
	if ($opt{chown} || $opt{chgrp} || $opt{chmod}) {
	    my $uid = $opt{chown} || (stat "$idedir/uid")[4];
	    $uid = (getpwnam($uid))[2] unless $uid =~ /^\d+$/;
	    my $gid = $opt{chgrp} || (stat "$idedir/gid")[5];
	    $gid = (getgrnam($gid))[2] unless $gid =~ /^\d+$/;
	    if ($opt{replace}) {
		my $fp = Argv->new('/usr/atria/etc/utils/fix_prot');
		$fp->opts(qw(-root -recurse));
		$fp->opts($fp->opts, '-force')  if $opt{force};
		$fp->opts($fp->opts, '-chown', $uid);
		$fp->opts($fp->opts, '-chgrp', $gid);
		$fp->opts($fp->opts, '-chmod', $opt{chmod}) if $opt{chmod};
		$fp->args($vws);
		if ($fp->system) {
		    $rc = 1;
		    next;
		}
	    } else {
		if ($opt{chown} || $opt{chgrp}) {
		    unlink("$idedir/group.$gid") if $opt{chgrp};
		    if (Argv->chown([qw(-R -h)], "$uid:$gid", $vws)->system) {
			$rc = 1;
			next;
		    }
		}
		if ($opt{chmod}) {
		    if (Argv->chmod(['-R'], $opt{chmod}, $vws)->system) {
			$rc = 1;
			next;
		    }
		    for my $grp (glob("$idedir/group.*")) {
			chmod(0102410, $grp) || warn Msg('W', "$grp: $!");
		    }
		}
		chmod(0104400, "$idedir/uid") ||
					    warn Msg('W', "$idedir/uid: $!");
		chmod(0102410, "$idedir/gid") ||
					    warn Msg('W', "$idedir/gid: $!");
	    }
	}
	if ($opt{delete_group}) {
	    for (split ',', $opt{delete_group}) {
		my $gid = /^\d+$/ ? $_ : (getgrnam($_))[2];
		if (! $gid) {
		    warn Msg('W', "no such group: $_");
		    $rc = 1;
		    next;
		}
		my $grp = "$idedir/group.$gid";
		unlink($grp);
	    }
	}
	if ($opt{add_group}) {
	    for (split ',', $opt{add_group}) {
		my $gid = /^\d+$/ ? $_ : (getgrnam($_))[2];
		if (! $gid) {
		    warn Msg('W', "no such group: $_");
		    $rc = 1;
		    next;
		}
		my $grp = "$idedir/group.$gid";
		unlink($grp);
		if (! open(GID, ">$grp")) {
		    warn Msg('W', "$vws: unable to add group $_");
		    $rc = 1;
		    next;
		}
		close(GID);
		if (! chown(-1, $gid, $grp) || ! chmod(0102410, $grp)) {
		    warn Msg('W', "$vws: unable to add group $_: $!");
		    $rc = 1;
		    next;
		}
	    }
	}
    }
    exit($rc);
}

=item * RECO/RECHECKOUT

Redoes a checkout without the database operations by simply copying the
contents of the existing checkout's predecessor over the view-private
checkout file. The previous contents are moved aside to "<element>.reco".
The B<-keep> and B<-rm> options are honored by analogy with I<uncheckout>.

=cut

sub recheckout {
    my %opt;
    GetOptions(\%opt, qw(keep rm));
    shift @ARGV;
    require File::Copy;
    for (@ARGV) {
	$_ = readlink if -l && defined readlink;
	if (! -w $_) {
	    warn Msg('W', "$_: not checked out");
	    next;
	}
	my $pred = Pred($_, 1);
	my $keep = "$_.reco";
	unlink $keep;
	if (rename($_, $keep)) {
	    if (File::Copy::copy($pred, $_)) {
		my $mode = (stat $keep)[2];
		chmod $mode, $_;
	    } else {
		die Msg('E', (-r $_ ? $keep : $_) . ": $!");
	    }
	} else {
	    die Msg('E', "cannot rename $_ to $keep: $!");
	}
	unlink $keep if $opt{rm};
    }
    exit 0;
}

=item * RMELEM

It appears that when elements are removed with I<rmelem> they often
remain visible for quite a while due to some kind of view cache,
though attempts to actually open them result in an I/O error. Running
I<cleartool setcs -current> clears this up. Thus I<rmelem> is
overridden here to add an automatic view refresh when done.

=cut

sub rmelem {
    my $rc = ClearCase::Argv->new(@ARGV)->system;