File Coverage

blib/lib/VCS/Vss.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package VCS::Vss;

use strict;
use vars qw($VERSION);
use VCS::Vss::Dir;
use VCS::Vss::File;
use VCS::Vss::Version;

$VERSION = '0.20';

my $vss;

sub _open_vss_db {
	my($self) = @_;

	my $vss = new Win32::OLE("SourceSafe.0");
	my $srcsafe_ini = $self->srcsafe_ini();
	$srcsafe_ini =~ s|/|\\|g;
 	$vss->Open($srcsafe_ini);

	if (!$vss->{SrcSafeIni}) {
		die "Couldn't open VSS database at: " . $self->srcsafe_ini() . "\n" . Win32::OLE::LastError;
	}

	$self->{vss} = $vss;
	return 1;
}

sub _vss_conn {
	my($self) = @_;
	unless($self->{vss}) {
		$self->_open_vss_db();
	}
	$vss = $self->{vss};
	return $self->{vss};
}

sub _fix_path {
	my ($self) = @_;
	my $new_path;

	# Remove ignored query portion of path
	$self->{PATH} =~ s/\?.+//;
	$self->{URL} =~ s/\?.+//;

	# Patch provided by Tim Hood  to handle spaces in URLs (taken from CGI unescape function)
	$self->{PATH} =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;

	($self->{SRCSAFE_INI}, $new_path) = $self->{PATH} =~ m|^/(.+)srcsafe.ini/(.+)|;
	if ($self->{SRCSAFE_INI}) {
		$self->{PATH} = '$/' . $new_path;
		$self->{SRCSAFE_INI} .= 'srcsafe.ini';
	}
	else {
		$self->{PATH} =~ s|^/||;
		$self->{PATH} = '$/' . $self->{PATH};
		$self->{SRCSAFE_INI} = $ENV{VSSROOT} . "/srcsafe.ini";
	}
    die ref($self) . "->new: " . $self->srcsafe_ini . " not a VSS ini file: $!"
        unless -f $self->srcsafe_ini;
	return 1;
}

sub _get_vss_item {
	my ($self) = @_;
	my $vss_item = $self->_vss_conn->VSSItem($self->path);
	if (!$vss_item) {
		die ref($self) . "->new: " . $self->path . " is not a valid VSS path for this database";
	}
	return $vss_item;
}

sub vss_object {
	my ($self) = @_;
	if (ref($self) eq 'VCS::Vss') {
		return $self->_vss_conn();
	}
	return $self->{vss_object} if $self->{vss_object};
	$self->{vss_object} = $self->_get_vss_item($self->path);
	return $self->{vss_object};
}

sub cleanup {
	$vss->Quit() if $vss;
}

sub srcsafe_ini {
	my ($self) = @_;
	return $self->{SRCSAFE_INI};
}

1;


__END__