view release on metacpan or  search on metacpan

DSB.pm  view on Meta::CPAN

    }
    Assert($tag);
    # If anything left in @ARGV has whitespace, quote it against its
    # journey through the "setview -exec" shell.
    for (@ARGV) {
	if (/\s/ && !/^(["']).*\1$/) {
	    $_ = qq('$_');
	}
    }
    # Last, run the setview cmd we've so laboriously constructed.
    unshift(@ARGV, '_inview');
    if ($opt{'exec'}) {
	push(@ARGV, '-_exec', qq("$opt{'exec'}"));
    }
    my $vwcmd = "$^X -S $0 @ARGV";
    # This next line is required because 5.004 and 5.6 do something
    # different with quoting on Windows, no idea exactly why or what.
    $vwcmd = qq("$vwcmd") if MSWIN && $] > 5.005;
    push(@sv_argv, '-exec', $vwcmd, $tag);
    # Prevent \'s from getting lost in subsequent interpolation.
    for (@sv_argv) { s%\\%/%g }
    # Hack - assume presence of $ENV{_} means we came from a UNIX-style
    # shell (e.g. MKS on Windows) so set quoting accordingly.
    my $cmd_exe = (MSWIN && !$ENV{_});
    Argv->new($^X, '-S', $0, 'setview', @sv_argv)->autoquote($cmd_exe)->exec;
}

## undocumented helper function for B<workon>
sub _inview {
    my $tag = (split(m%[/\\]%, $ENV{CLEARCASE_ROOT}))[-1];
    #Argv->new([$^X, '-S', $0, 'setcs'], [qw(-sync -tag), $tag])->system;

    # If -exec foo was passed to workon it'll show up as -_exec foo here.
    my %opt;
    GetOptions(\%opt, qw(_exec=s)) if grep /^-_/, @ARGV;

    my @cs = Argv->new([$^X, '-S', $0, 'catcs'], [qw(--expand -tag), $tag])->qx;
    chomp @cs;
    my($iwd, $venv, @viewenv_argv);
    for (@cs) {
	if (/^##:Start:\s+(\S+)/) {
	    $iwd = $1;
	} elsif (/^##:ViewEnv:\s+(\S+)/) {
	    $venv = $1;
	} elsif (/^##:([A-Z]+=.+)/) {
	    push(@viewenv_argv, $1);
	}
    }

    # If an initial working dir is supplied cd to it, then check for
    # a viewenv file and require it if so.
    if ($iwd) {
	print "+ cd $iwd\n";
	# ensure $PWD is set to $iwd within req'd file
	require Cwd;
	Cwd::chdir($iwd) || warn "$iwd: $!\n";
	my($cli) = grep /^viewenv=/, @ARGV;
	$venv = (split /=/, $cli)[1] if $cli;
	$venv ||= '.viewenv.pl';
	if (-f $venv) {
	    local @ARGV = grep /^\w+=/, @ARGV;
	    push(@ARGV, @viewenv_argv) if @viewenv_argv;
	    print "+ reading $venv ...\n";
	    eval { require $venv };
	    warn Msg('W', $@) if $@;
	}
    }

    # A reasonable default for everybody.
    $ENV{CLEARCASE_MAKE_COMPAT} ||= 'gnu';

    for (grep /^(CLEARCASE_)?ARGV_/, keys %ENV) { delete $ENV{$_} }

    # Exec the default shell or the value of the -_exec flag.
    my $final = Argv->new;
    if (! $opt{_exec}) {
	if (MSWIN) {
	    $opt{_exec} = $ENV{SHELL} || $ENV{ComSpec} || $ENV{COMSPEC}
				|| (-x '/bin/sh.exe' ? '/bin/sh' : 'cmd');
	} else {
	    $opt{_exec} = $ENV{SHELL} || (-x '/bin/sh' ? '/bin/sh' : 'sh');
	}
    }
    #system("title workon $tag") if MSWIN;
    $final->prog($opt{_exec})->exec;
}

=back

=head1 COPYRIGHT AND LICENSE

Copyright (c) 1997-2002 David Boyce (dsbperl AT boyski.com). All rights
reserved.  This Perl program is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

perl(1), ClearCase::Wrapper

=cut