package Continuus;
$VERSION = '0.1';
=head1 NAME
Continuus - Perl interface to Continuus CM
=head1 SYNOPSIS
use Continuus;
Check out a file:
use Continuus;
$ccm = new Continuus;
$ccm->start(database => '/proj/Continuus4/rig',
host => 'stoxserv01');
$ccm->checkOut(file => 'main.c',
version => '2');
$ccm->stop();
=head1 DESCRIPTION
The Continuus perl module is a interface to the most common Continuus functions.
=cut
=head1 CHANGE HISTORY
0.1 Created.
=cut
use strict;
=head1 METHODS
=over 4
=cut
################################################################################
=item new:
The new method creates a new Continuus object.
=cut
sub new() {
my $self = {};
$self->{DEBUG} = 0;
bless($self);
return $self;
};
################################################################################
=item start:
The start method starts a new Continuus session.
Parameters:
database: Database to open.
host: Hostname to start the engine on.
iniFile: Ini file to read.
Example:
$ccm->start(database => "/proj/Continuus0/rig/", host => "stoccm01");
=cut
sub start() {
my $self = shift;
my %args = @_;
my ($command);
$command = "ccm start -m -q -nogui $args{'database'} $args{'host'} $args{'iniFile'} 2>&1";
$self->printDebug("$command");
my $CCM_ADDR = `$command`;
if ($? ne 0) {
# Continuus startup failed
warn "$CCM_ADDR\n";
delete $ENV{CCM_DATETIME_FMT};
delete $ENV{CCM_INI_FILE};
return 0;
}
$ENV{CCM_ADDR} = "$CCM_ADDR";
return 1;
};
################################################################################
=item command:
The command method acts as a interface to all other Continuus functions
not implemented in the Continuus module.
Parameters:
command: The command to be executed by Continuus
Example:
$ccm->command('status');
=cut
sub command() {
my $self = shift;
my $command = shift;
my $result;
printDebug($command);
$result = `ccm $command`;
print "$result\n";
};
################################################################################
=item stop:
The stop command quits the current Continuus session.
Parameters:
None.
=cut
sub stop() {
my $StopMessage = `ccm stop 2>&1`;
if ($? ne 0) {
# Continuus stop failed
warn "Continuus stop failed.\n$StopMessage\n";
return 0;
}
return 1;
};
#################################################################################
=item query:
The query command is a interface to the Continuus query command.
Parameters:
query: The query string
flags: Flags to pass to Continuus.
Format: Formatting options.
Example:
$ccm->query(query => "status='released'", flags => "-u", format => "%objectname");
=cut
sub query() {
my $self = shift;
my %args = @_;
my ($output,$command,@list);
$command = "ccm query \"$args{'query'}\" $args{'flags'} -f \"$args{'format'}\" 2>&1";
$self->printDebug($command);
$output = `$command`;
$self->printDebug($output);
@list = split('/\r?\n/', $output);
$self->printDebug($#list);
for (@$output) {
$_ = untaint($_)
};
if ($? ne 0) {
if (@$output >= 1) {
# One or more lines returned, can only be warnings.
warn "ccm query failed to execute: @$output";
return 0;
}
else {
# This is NOT an error situation!
# If no objects versions found ccm also returns 1.
return 1;
}
}
return 1;
};
################################################################################
=item checkOut:
Checks out a file.
Parameters:
file: The file to check out.
version: The version to set on the new file.
Example:
$ccm->checkOut(file => "main.c", version => "1.1");
=cut
sub checkOut() {
my $self = shift;
my %args = @_;
my ($result, $command);
if (defined $args{'version'}) {
$args{'version'} = "-to $args{'version'}";
}
$command = "ccm co $args{'version'} $args{'file'}";
$result = `$command`;
return $?;
}
################################################################################
=item checkIn:
Checks in a file.
Parameters:
file: The file to check out.
comment: The comment to set on the new file.
Example:
$ccm->checkIn(file => "main.c", comment => "Created");
=cut
sub checkIn() {
my $self = shift;
my %args = @_;
my ($result, $command);
if (defined $args{'comment'}) {
$args{'comment'} = "-c $args{'comment'}";
}
else {
$args{'comment'} = "-nc";
}
$command = "ccm ci $args{'comment'} $args{'file'}";
$result = `$command`;
return $?;
}
################################################################################
=item reconfigure:
Reconfigure command
Parameters:
project: The project to reconfigure.
parameters: Other parameters to pass to the reconfigure command.
Example:
$ccm->checkOut(file => "main.c", version => "1.1");
=cut
sub reconfigure() {
my $self = shift;
my %args = @_;
my ($result, $command);
$command = "ccm reconf -p $args{'project'} $args{'parameter'}";
$result = `$command`;
return $?;
}
################################################################################
sub printDebug() {
my $self = shift;
my $tString = shift;
if($self->{DEBUG} == 1) {
print "DEBUG: $tString\n";
}
};
################################################################################
=item debugOn:
Sets the debugging information on.
=cut
sub debugOn() {
my $self = shift;
$self->{DEBUG} = 1;
}
################################################################################
=item debugOff:
Sets the debugging information off.
=cut
sub debugOff() {
my $self = shift;
$self->{DEBUG} = 0;
}
################################################################################
sub untaint($) {
my $ToUntaint = shift();
if ($ToUntaint =~ /(.+)/ms) { $ToUntaint = $1; }
return $ToUntaint;
};
################################################################################
=head1 AUTHOR
Henrik Jönsson henrik7205@hotmail.com
=cut
1;