view release on metacpan or  search on metacpan

MGi.pm  view on Meta::CPAN

  if (my $fmt = $desc->flagCC('fmt')) { # Maybe already modified
    my $ph = 'PlAcEhOlDeR';
    if ($fmt =~ s/\%\[(.*?)\](N?)l/$ph/) {
      my ($re, $ncom) = (qr($1), $2);
      my @args = $desc->args;
      my $fix = 0;
      for (@{$desc->{AV_OPTS}{CC}}) {
	$fix++;
	last if /^-fmt$/;
      }
      $CT = new ClearCase::Argv({autochomp=>1}) unless $CT;
      for (@args) {
	my @lb = grep /$re/, split / /, $CT->des([qw(-fmt %Nl)], $_)->qx;
	my $lb = $ncom? join(' ', @lb) : @lb? '(' . join(', ', @lb) . ')' : '';
	(my $f = $fmt) =~ s/$ph/$lb/;
	$desc->{AV_OPTS}{CC}->[$fix] = $f;
	$rc |= $desc->args($_)->system('CC');
      }
      exit $rc;
    }
  }
  $rc |= $desc->system('CC');
  exit $rc; # avoid fallback!
}

=item * MKVIEW

Enhancement. Clone, equivalent fixed config spec.
Works only for dynamic views, as I don't know how to get the snapshot
view directory

=cut

sub mkview {
  use strict;
  use warnings;
  use File::Basename;
  use File::Spec;
  use File::Temp qw(tempfile);
  use Sys::Hostname;
  use Date::Format;
  use Date::Parse;
  my $mkv = ClearCase::Argv->new(@ARGV);
  $mkv->optset(qw(CC WRAPPER));
  $mkv->parseCC(qw(snapshot tag=s tcomment=s tmode=s region=s stream=s
		   shareable_dos|nshareable_dos cachesize=s
		   stgloc=s host=s hpath=s gpath=s
		   colocated_server vws=s));
  $mkv->parseWRAPPER(qw(clone=s equiv=s quiet));
  return 0 unless $mkv->flagWRAPPER('clone'); # fallback!
  my $tag = $mkv->flagCC('tag');
  if (!$tag) {
    warn Msg('E', 'View tag must be specified.');
    @ARGV = qw(help mkview);
    ClearCase::Wrapper->help();
    return 1;
  }
  $CT = ClearCase::Argv->new({autochomp=>0});
  my $lsv = $CT->lsview([qw(-l -prop -full)], $mkv->flagWRAPPER('clone'))->qx;
  return 1 unless $lsv;
  my %tm = (unix=>'transparent', msdos=>'insert_cr', strip_cr=>'strip_cr');
  my ($tmo, @prop) = ($tm{$1}, split /\s+/, $2)
    if $lsv =~ /Text mode: (.*?)\n.*Properties: (.*?)\n/s;
  die Msg('E', 'Snapshot views not supported for cloning!')
    if grep /^snapshot$/, @prop or $mkv->flagCC('snapshot');
  my @nsup = grep !/(dynamic|shareable_dos|readwrite|readonly)$/, @prop;
  die Msg('E', "Non supported for cloning: @nsup") if @nsup;
  $tmo = $mkv->flagCC('tmode') if $mkv->flagCC('tmode');
  my $shdo = $mkv->flagCC('shareable_dos');
  ($shdo) = grep /shareable_dos$/, @prop unless $shdo;
  my @k = grep !/(stgloc|host|hpath|gpath|tmode|shareable_dos)/,
    keys %{$mkv->{AV_LKG}{'CC'}};
  my @opts = (map(("-$_", $mkv->flagCC($_)), @k), '-tmo', $tmo, "-$shdo");
  my ($host, $ogpa, $hpa, $own) = ($2, $1, $3, $4)
    if $lsv =~ m{ \QGlobal path: \E(.*?)\n.*
		  \QServer host: \E(.*?)\n.*
		  \Qaccess path: \E(.*?)\n.*
		  \QView owner: \E(?:.*?/)(.*?)\n
	      }xs;
  if ($mkv->flagCC('stgloc')) {
    push @opts, '-stg', $mkv->flagCC('stgloc');
  } else {
    my $pwnam = (getpwuid($<))[0];
    if ($mkv->flagCC('hpath')) {
      $hpa = $mkv->flagCC('hpath');
    } else {
      my $pdir = dirname($hpa);
      if (basename($pdir) eq $own) {
	$hpa = File::Spec->catdir(dirname($pdir), $pwnam, "$tag.vws");
      } else {
	$hpa = File::Spec->catdir($pdir, "$tag.vws");
      }
    }
    my $gpa = $mkv->flagCC('gpath');
    if (!$gpa) {
      my $pdir = dirname($ogpa);
      if (basename($pdir) eq $own) {
	$gpa = File::Spec->catdir(dirname($pdir), $pwnam, "$tag.vws");
      } else {
	$gpa = File::Spec->catdir($pdir, "$tag.vws");
      }
    }
    $host = $mkv->flagCC('host') if $mkv->flagCC('host');
    push @opts, '-host', $host, '-hpa', $hpa, '-gpa', $gpa;
    if (!$mkv->args) {
      if ($host eq hostname or $gpa =~ m%^//%) { #UNC gives 'Access is denied'
	$mkv->args($hpa);
      } else {
	$mkv->args($gpa);	#Should work from anywhere
      }
    }
  }
  $mkv->opts(@opts);
  my $cs = File::Spec->catfile($ogpa, 'config_spec');
  my (@eqlst, $lb, $ts, $lbt, $nr, $rt); #reference time
  if (my $eq = $mkv->flagWRAPPER('equiv')) {
    ($lb, $ts) = split /,/, $eq;
    $CT->autochomp(1);
    $lbt = "lbtype:$lb";
    if ($lb =~ /^lbtype:(.*)$/) {
      $lbt = $lb;