Continuus - Perl interface to Continuus CM
Index
Code Index:
NAME

Continuus - Perl interface to Continuus CM
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();
DESCRIPTION

The Continuus perl module is a interface to the most common Continuus functions.
CHANGE HISTORY

METHODS

- new:
-
The new method creates a new Continuus object.
- 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");
- 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');
- stop:
-
The stop command quits the current Continuus session.
Parameters:
None.
- 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");
- 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");
- 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");
- 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");
- debugOn:
-
Sets the debugging information on.
- debugOff:
-
Sets the debugging information off.
AUTHOR

Henrik Jönsson henrik7205@hotmail.com
package Continuus;
$VERSION = '0.1';
use strict;
################################################################################
sub new() {
my $self = {};
$self->{DEBUG} = 0;
bless($self);
return $self;
};
################################################################################
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;
};
################################################################################
sub command() {
my $self = shift;
my $command = shift;
my $result;
printDebug($command);
$result = `ccm $command`;
print "$result\n";
};
################################################################################
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;
};
#################################################################################
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;
};
################################################################################
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 $?;
}
################################################################################
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 $?;
}
################################################################################
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";
}
};
################################################################################
sub debugOn() {
my $self = shift;
$self->{DEBUG} = 1;
}
################################################################################
sub debugOff() {
my $self = shift;
$self->{DEBUG} = 0;
}
################################################################################
sub untaint($) {
my $ToUntaint = shift();
if ($ToUntaint =~ /(.+)/ms) { $ToUntaint = $1; }
return $ToUntaint;
};
################################################################################
1;