File Coverage

blib/lib/ClearCase/Attache.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package ClearCase::Attache;

use strict;

use Carp;
use Symbol;
use Win32;
use vars qw ($VERSION $ATTCMD $AUTOLOAD);
#
$VERSION = '0.01';
#
$ATTCMD="C:\\Program Files\\Rational\\Attache\\bin\\attcmd.exe";
$ATTCMD=((-x $ATTCMD )? $ATTCMD: pathfind('attcmd.exe'));

#============
#==METHODS===
#============
# Constructor
sub new {
    my($pkg,$ws,$attache)=(@_);
    my $self = {};
    #
    carp( "Workspace needed") unless $ws;
    $self->{_WS_}=$ws;
    #
    if ($attache) {
	carp("no $attache or not executable")
	    unless -x $attache;
    } else {
	carp("ATTACHE not specified and no default exists")
	    unless -x $ATTCMD;
	$attache=$ATTCMD;
    }
    $self->{_ATTCMD_}=Win32::GetShortPathName($attache);
    #
    bless $self,$pkg;
}
# If we want to use a log file.
sub setlog {
    my($self,$logfile,$append)=(@_);
    if($logfile) {
	my $h=gensym();
	open($h,($append? '>>' : '>'),$logfile)
	    or (carp("Opening $logfile: $!"),return);
	$self->{_LOG_}=$logfile;
	print $h "***Start logging at:", scalar(localtime()),"\n";
	close $h;  # Needed on windoze to preserve the log file.
    } else {
	delete $self->{_LOG_};
    }
    $logfile;
}
# maps workspace to physical location
sub vault {
    my($self)=(@_);
    my $ws=$self->{_WS_};
    $self->lsws();

    foreach my $l ($self->lastoutput()) {
	next if ($l=~/^Workspace name/);
	$l=~s/^\s+//;
	$l=~s/^\*\s*//;
	my ($ows,$locdir,$host)=(split(/\s+/,$l));
	return $locdir if ($ows eq $ws);
    }
    return;
}
# result of the latest command
sub lastoutput {
    my($self)=(@_);
    @{ $self->{_OUT_} };
}
# workspace accessors
sub getWs {
    $_[0]->{_WS_};
}

sub setWs {
    $_[0]->{_WS_}=$_[1];
}

# error flag
sub hasErrors {
    $_[0]->{_HASERRORS_}? 1: 0;
}
# error messages
sub errors {
    @{$_[0]->{_ERR_}};
}
# warning flags
sub hasWarnings {
    $_[0]->{_HASWARNINGS_}? 1: 0;
}
#warning content
sub warnings {
    @{$_[0]->{_WARN_}};
}
# run an arbitrary attache command
sub runcmd {
    my($self,$args)=(@_);
    my($ws)=($self->{_WS_});

    my($h)=(gensym());  #from Symbol
    my $cmd="$self->{_ATTCMD_} -ws $ws $args"; #No quotes, we used getshort..
    # get logfile
    my $log=gensym();
    if (exists $self->{_LOG_}) {
	my $logfile=$self->{_LOG_};
	open($log,'>>',$logfile)
	    or (carp("Opening $logfile: $!"),$log=undef());
    }
    $log && (print $log "$cmd\n");
    open($h,"-|",$cmd) or
	(carp("$! while invoking: $cmd"),return);
	#
    my($out,$err,$warn);
    $out=[];
    $err=[];
    $warn=[];
    $self->{_ERR_} =undef;
    $self->{_WARN_}=undef;
    $self->{_HASERRORS_} =0;
    $self->{_HASWARNINGS_}=0;
    $self->{_OUT_} =undef;
    #
    while(<$h>) {
	next if /^Ready/;
	next if /^Setting workspace to/;
	chomp;
	substr($_,-1)=undef if(substr($_,-1) eq "\r");
	$log && (print $log '# ',$_,"\n");
	if (/Error:/) {
	    push @{$err},$_ ;
	    $self->{_HASERRORS_}++;
	} elsif(/Warning:/) {
	    push @{$warn},$_ ;
	    $self->{_HASWARNINGS_}++;
	} else {
	    push @{$out},$_;
	}
    }
    close $h;
    $log && close $log;

    $self->{_ERR_}=$err if {$#{$err}>= 0};
    $self->{_WARN_}=$warn if {$#{$warn}>=0};
    $self->{_OUT_}=$out;
    1;
}
# Delegates everything to runcmd
sub AUTOLOAD {
    my($self,$args)=(@_);
    my($cmd);

    ($cmd=$AUTOLOAD)=~s/.*:://;
    $self->runcmd("$cmd $args");
}

sub DESTROY {} #avoids AUTOLOAD on destroy
#=============
#==UTILITIES==
#=============

sub pathfind {
    my($f)=(@_);
    my($sep)=(($^O=~/mswin/i)?';':':');
    foreach my $dir (split($sep,$ENV{PATH})) {
	return  "$dir/$f" if (-x "$dir/$f" );
    }
    return
}

#========
#==OVER==
#========
1;
__END__