view release on metacpan or  search on metacpan

StarTeam.pm  view on Meta::CPAN

package VCS::StarTeam;

#require 5.005_62;
use strict;
use warnings;

use Carp;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use VCS::StarTeam ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
hist history list log checkout get co diff vdiff checkin ci put
);

our $VERSION = '0.08';


# Preloaded methods go here.

#
# constructor
#
sub new {
	my( $class, $optionRef ) = @_;

	$class = ref($class) || $class;

	my( $self ) = ( ref( $optionRef ) eq 'HASH' ) ? $optionRef : {};

	my( $username ) = $^O eq 'MSWin32' ? $ENV{'USERNAME'}
	    : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'}
	    : $^O eq 'MacOS' ? $ENV{'USER'}
	    : eval { getpwuid($<) };	# May be missing

	my( %default ) = (
		'batchmode'		=> 0,
		'compress'		=> 0,
		'host'			=> 'localhost',
		'endpoint'		=> '1024',
		'project'		=> '',
		'password'		=> '',
		'path'			=> '',
		'recurse'		=> 0,
		'stoponerror'	=> 0,
		'username'		=> $username,
		'verbose'		=> 0,
		'view'			=> '',
	);

	for my $option ( keys( %default ) ) {
		$self -> {$option} = $default{$option} if ( ! defined( $self -> {$option} ) );
		print "$option = $self->{$option}\n";
	}
	
	croak("Failure: No project name specified")	if ( ! $self->{'project'} );

	return bless $self, $class;
}

#
# private routine for creating project string for stcmd commands
#
sub _getpparam {
	my( $self ) = shift;
	my( $pparam ) = join( '', $self->{'username'}, ":", 
		$self->{'password'}, "\@", $self->{'host'}, ":",
		$self->{'endpoint'}, "/", $self->{'project'}, "/", 
		$self->{'view'}, "/", $self->{'path'} );   
	return $pparam;
}

#
# hist methods
#
sub history {
	# convenience method for calling _hist
	my( $self ) = shift;
	$self->_hist( @_ );	
}

sub hist {
	# convenience method for calling _hist
	my( $self ) = shift;
	$self->_hist( @_ );	
}

sub log {
	# convenience method for calling _hist
	my( $self ) = shift;
	$self->_hist( @_ );	
}

sub _hist {