| Current Path : /var/www/web-klick.de/dsh/10_customer2017/1204__intel/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/10_customer2017/1204__intel/scwa |
#!/opt/perl_5.8.8/bin/perl -w
use strict;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use ClearCase::CtCmd qw(cleartool);
use ClearCase::MtCmd qw(multitool);
use File::Temp qw(tempfile);
use YAML::XS qw(Dump);
BEGIN {
if($ENV{WORKAREA}) {
push(@INC, "$ENV{WORKAREA}/stools/lib/perl");
}
}
use CCAPI;
use CmDbClient;
use CSgen;
our $VERSION = '1.7.0';
# poor man's implementation of Term::Completion
if($^O =~ /win/i) {
local $/ = undef;
eval <DATA>;
die $@ if $@;
} else {
require Term::Completion;
Term::Completion->import();
}
# default options
my %opt = (
batch => 200,
recommended => 'RECOMMENDED_LABEL',
server => ($ENV{ACS_SERVER} || 'https://acs.lz.imc.local'),
timeout => 2,
verbose => 0
);
unless(GetOptions(\%opt, qw(
acs=s
baseline=s
batch=i
comment=s
commit!
deliver!
element=s
freeze=s
fulllabel!
gui!
help!
ibranch=s
iemail=s
integrate!
man!
notask
obsolete
rebase!
server=s
setup!
show!
timeout=i
unlock
verbose|v+
view=s
vobs=s
))) {
pod2usage(-exitval => 1, -verbose => 0);
}
if($opt{help}) {
print "\n$0 Version $VERSION\n\n";
pod2usage(-exitval => 0, -verbose => 0);
}
if($opt{man}) {
pod2usage(-exitval => 0, -verbose => 3);
}
our $MAINWINDOW;
our $User = $^O =~ /win/i ? getlogin() : getpwuid($<);
our $Ibranch;
our $TaskBranch;
our $ACS;
our $Status = 0;
our $Action;
if($opt{gui}) {
_setup_gui();
}
# determine VOBs to process
my $CCAPI = CCAPI->new(
VERBOSITY => $opt{verbose},
$opt{vobs} ? (VOBS => [split(/[\s,:;]+/, $opt{vobs})]) : (),
$opt{gui} ? (LOG_INFO => \&_log_gui, LOG_WARN => \&_log_gui) : ()
);
# get the server connection
my ($acs_host, $acs_port) = $opt{server} =~ /^(https?:[^:]+):?(\d*)$/;
my $CmDbClient = CmDbClient->new(
VERBOSITY => $opt{verbose},
HOST => $acs_host, PORT => $acs_port,
$opt{gui} ? (LOG_INFO => \&_log_gui, LOG_WARN => \&_log_gui) : ()
);
# get current view
our ($VIEW,@VIEWS) = $CCAPI->get_views(VIEW => $opt{view}, ELEMENT => $opt{ELEMENT},
USER => $User);
unless($VIEW) {
$CCAPI->log_warn(0, "[ERROR] Cannot determine current view, aborting.\n");
$Status = 2;
goto The_End;
}
$CCAPI->log_info(0, "[INFO] The current view is '$VIEW'\n");
# check & mount VOBs
$CCAPI->add_vobs_from_view();
unless($CCAPI->check_vobs) {
$CCAPI->log_warn(0, "[ERROR] No VOBs identified... please use the -vobs option.\n");
$Status = 2;
goto The_End;
}
our @VOBs = $CCAPI->get_vobs;
$CCAPI->log_info(0, "[INFO] List of VOBs: @VOBs\n");
# only setup
if($opt{setup}) {
$CCAPI->setup_vobs;
$CCAPI->log_info(0, "[INFO] Setup completed in VOBs: @VOBs\n");
goto The_End;
}
# commit - check in all checkouts
if($opt{commit} && !$opt{gui}) {
# TODO could be a GUI of it's own
_commit();
goto The_End;
}
# determine which task branch to use
$TaskBranch = shift @ARGV;
if($TaskBranch) {
unless($CCAPI->check_branch_name(NAME => $TaskBranch)) {
$Status = 2;
goto The_End;
}
}
elsif($VIEW) {
_view_selected(0);
}
# special case: "main" branch - only set default config spec
if($TaskBranch && $TaskBranch eq 'main') {
$CCAPI->log_info(0, "[INFO] Setting default config spec.\n");
my $new_cs = $^O =~ /win/i ? <<"EOT"
# default config spec
element * CHECKEDOUT
element * \\main\\LATEST
EOT
: <<"EOT";
# default config spec
element * CHECKEDOUT
element * /main/LATEST
EOT
$CCAPI->set_config_spec(CONTENT => $new_cs) || exit 1;
}
# get current config spec
our $OLD_CS = $CCAPI->get_config_spec(VIEW => $VIEW);
# determine task branch
if(!$opt{notask} && !defined $TaskBranch) { # no branch name specified
if($opt{rebase} || $opt{show} || $opt{deliver}) {
# try to determine the branch from the config spec
if($OLD_CS =~ /^\s*#\s+task branch:\s+(\S+)/m) {
$TaskBranch = $1;
unless($CCAPI->check_branch_name(NAME => $TaskBranch)) {
$CCAPI->log_warn(0, "[ERROR] Illegal task branch name '$TaskBranch' as defined in current config spec.\n");
$TaskBranch = '';
} else {
$CCAPI->log_info(0, "[INFO] Using task branch '$TaskBranch' as defined in current config spec.\n");
}
}
}
}
# default integration branch
if($opt{ibranch}) {
$Ibranch = $opt{ibranch};
if($ENV{INTEGRATION_BRANCH} && $ENV{INTEGRATION_BRANCH} ne $Ibranch) {
$CCAPI->log_warn(0, "[WARNING] Command line '-ibranch $Ibranch' overrides environment INTEGRATION_BRANCH=$ENV{INTEGRATION_BRANCH}\n");
}
}
elsif($ENV{INTEGRATION_BRANCH}) {
$Ibranch = $ENV{INTEGRATION_BRANCH};
}
if($opt{gui}) {
if($opt{notask}) {
$TaskBranch = '-none-';
}
if($TaskBranch && $TaskBranch ne '-none-') {
_branch_selected(1);
} else {
_init_acs_entries();
}
MainLoop();
if($Action =~ /cancel/i) {
$Status = 0;
}
} else { # no GUI
if(!$opt{notask} && !defined $TaskBranch) {
# query for task branch
# get existing task branches relative to $Ibranch
unless($Ibranch) {
$CCAPI->log_warn(0, "[ERROR] No integration branch defined. Use -notask or specify integration branch with -ibranch.\n");
$Status = 1;
goto The_End;
}
my @brtypes = check_ibranch($Ibranch);
# interactive query for a branch
my $tc = ($opt{rebase} || $opt{integrate} || $opt{show}) ?
Term::Completion->new(
prompt => "Please choose an existing branch: ",
validate => 'fromchoices',
choices => \@brtypes)
:
Term::Completion->new(
prompt => "Please choose a branch or enter a new one: ",
validate => [
'Branch name must start with a letter and must not contain special characters' =>
sub { $CCAPI->check_branch_name(NAME => $_[0]) }
],
choices => \@brtypes);
print "\n[INFO] When typing the branch, you can use the TAB key for completion!\n";
$TaskBranch = $tc->complete();
unless($TaskBranch) {
die "[ERROR] No branch selected.\n";
}
}
_do_work();
} # end gui/not-gui
# now we have a task branch name
The_End:
exit $Status;
##############################################################################
sub _do_work
{
# need to catch this
if($opt{notask} || !$TaskBranch || $TaskBranch eq '-none-') {
$opt{notask} = 1;
} else {
$opt{notask} = 0;
}
# set the integration email name list on the task branch
# (in case this is becoming a sibling integ branch)
if(!$opt{notask} && $opt{iemail}) {
my @integrators = split(/[\s,;]+/, $opt{iemail});
if(@integrators) {
$CCAPI->set_attribute_on_branch(BRANCH => $TaskBranch,
ATTRIBUTE => 'INTEGRATOR_EMAIL',
VALUE => join(',',@integrators));
}
}
# unlock a locked task branch
if(!$opt{notask} && $opt{unlock}) {
$CCAPI->unlock_branch(BRANCH => $TaskBranch);
# continue when rebasing
return unless $opt{rebase};
}
# nothing more to do for 'main' branch
if($TaskBranch && $TaskBranch eq 'main') {
return;
}
# no extra function - regular creation/setcs for a branch
# check whether branch exists
my $branch_acs;
if(!$opt{notask} && $TaskBranch) {
$branch_acs = $CCAPI->get_branch_acs(BRANCH => $TaskBranch);
if($branch_acs) {
$CCAPI->log_info(0, "[INFO] Will reuse existing branch '$TaskBranch', current ACS is '$branch_acs'.\n");
}
}
# ACS
my ($user,$project,$acs,$rev);
if($opt{acs}) {
($user,$project,$acs,$rev) = $CmDbClient->parse_acs_definition($opt{acs});
unless($acs) {
$CCAPI->log_warn(0, "[ERROR] Invalid ACS specified - check the -acs option.\n");
return;
}
}
if($branch_acs) {
my ($u,$p,$a,$r) = $CmDbClient->parse_acs_definition($branch_acs);
$user = $u unless defined $user;
$project = $p unless defined $project;
$acs = $a unless defined $acs;
$rev = $r unless defined $rev;
}
if($opt{gui} && !$project && !$acs && !$rev) {
$CCAPI->log_warn(0, "[ERROR] No ACS selected - select an ACS and try again.\n");
return;
}
# determine user - current user
$user = $User unless(defined $user);
# determine the project
$project = $project || $ENV{SMARTCM_PROJECT} || _get_project($user);
unless($project) {
$CCAPI->log_warn(0, "[ERROR] No project selected.\n");
return;
}
# determine the ACS
$acs = $acs || _get_acs($user,$project);
unless($acs) {
$CCAPI->log_warn(0, "[ERROR] No ACS selected.\n");
return;
}
# distinguish between generic and user-specific...
if($acs =~ m{^([^/]+)/(.*)$}) {
$user = $1;
$acs = $2;
} else {
$user = '';
}
# determine the ACS revision - it could be '0'
$rev = _get_rev($user,$project,$acs)
unless(defined($rev) && length($rev));
unless(defined($rev) && length($rev)) {
$CCAPI->log_warn(0, "[ERROR] No ACS revision selected.\n");
return;
}
# now we have all
my $new_acs = $CmDbClient->write_acs_definition(USER => $user, PROJECT => $project,
ACS => $acs, REVISION => $rev);
# get the ACS details
$ACS = $CmDbClient->get_ACS(PROJECT => $project, ACS => $acs, REV => $rev,
($user ? (USER => $user) : ()) );
unless($ACS) {
$CCAPI->log_warn(0, "[ERROR] Cannot retrieve ACS '$new_acs' from server.\n");
return;
}
# component and domain definitions
my ($ACS_cnd,$CnD_name, $CnD_rev);
$ACS_cnd = $ACS->getCnDSelector();
if($ACS_cnd && $ACS_cnd =~ /^([^.]+)\.([^.]+)$/) {
($CnD_name, $CnD_rev) = ($1,$2);
} else {
$CCAPI->log_warn(0, "[ERROR] ACS does not contain a valid Component/Domain definition.\n");
return;
}
my $CnD = $CmDbClient->get_CnD(PROJECT => $project,
REV => [ $CnD_name => $CnD_rev ]);
unless($CnD) {
$CCAPI->log_warn(0, "[ERROR] Cannot retrieve Component/Domain definition '$CnD_name.$CnD_rev' from server.\n");
return;
}
# integration branch
my $acs_ibranch = $ACS->getIntegrationBranch();
if($acs_ibranch) {
$Ibranch = $acs_ibranch;
$CCAPI->log_info(0, "[INFO] ACS defines integration branch '$Ibranch'.\n");
}
elsif($Ibranch) {
$CCAPI->log_warn(0, "[WARNING] Cannot determine integration branch from ACS, falling back to '$Ibranch'.\n");
}
else {
$CCAPI->log_warn(0, "[ERROR] Integration branch not defined on ACS nor globally. Use the -ibranch option.\n");
return;
}
# we may need a config spec include file
my ($inc_file, $inc_selector) = $ACS->getIncludeFileSelector;
# ... and we may have custom load rules for snapshop views
my @load_rules = $ACS->getCustomLoadRules;
# freeze the LATEST rules to timestamp?
my $freeze = $opt{freeze} || CSgen->time_to_cstime(time);
my $CSgen = CSgen->new(ACS => $ACS, CND => $CnD,
INCLUDE_FILE => $inc_file, INCLUDE_SELECTOR => $inc_selector,
($freeze ? (TIMESTAMP => $freeze) : ()),
VERBOSITY => $opt{verbose},
($opt{gui} ? (LOG_INFO => \&_log_gui, LOG_WARN => \&_log_gui) : ()),
($opt{notask} ? () : (TASK_BRANCH => $TaskBranch)),
($CCAPI->is_snapshot_view(VIEW => $VIEW) ? (LOADRULES => \@load_rules) : ()),
);
my @config_spec = $CSgen->generate_CS(COMMENTS => [
"# based on ACS $new_acs ($opt{server})"
]);
# merge VOB list - the subsequent steps need CLEARCASE_AVOBS
# correctly set to process all VOBs
$CCAPI->add_vobs($CSgen->get_VOBs);
# mount VOBs on Windows
$CCAPI->check_vobs;
# obsolete a branch - set state and lock obsolete
if(!$opt{notask} && $opt{obsolete}) {
_check_no_checkouts_on_branch($TaskBranch) || return;
my $state = $CCAPI->get_branch_state(BRANCH => $TaskBranch);
if(!$state || $state ne 'integrated') {
$CCAPI->set_attribute_on_branch(BRANCH => $TaskBranch,
ATTRIBUTE => 'TASK_STATE',
VALUE => 'obsolete');
}
$CCAPI->lock_obsolete_branch(BRANCH => $TaskBranch);
return;
}
# for integration, no checkout on source branch (other users!)
if(!$opt{notask} && $opt{deliver}) {
_check_no_checkouts_on_branch($TaskBranch) || return;
# ask for confirmation
my $confirm = 1;
my $integ = $CCAPI->get_integration_branch(BRANCH => $TaskBranch);
if($opt{gui}) {
my $dlg = $MAINWINDOW->Dialog(-title => 'Confirmation',
-text => "You are about to deliver task branch '$TaskBranch' to the\nintegration branch '$integ'. Is this what you want?",
-buttons => [qw(Continue Abort) ],
-default_button => 'Continue');
my $answ = $dlg->Show;
if($answ =~ /abort/i) {
$confirm = 0;
}
} else { # no GUI
print <<"EOT";
[INFO] You are about to deliver task branch '$TaskBranch' to the
integration branch '$integ'. Is this what you want?
EOT
print "[QUERY] Continue? [y/n] ";
my $answ = <STDIN>;
unless($answ && $answ =~ /^[jy]/i) {
$confirm = 0;
}
}
unless($confirm) {
$CCAPI->log_info(0, <<"EOT");
[INFO] Deliver aborted.
Please get in touch with your configuration management support in
case you need to integrate this taskbranch into a different
integration stream.
EOT
return;
}
# TODO here a pre-deliver check would go in
# ask for confirmation of comment
my $comment;
if($opt{comment}) { # from GUI
$comment = $opt{comment};
} else {
$comment = $CCAPI->get_branch_comment(BRANCH => $TaskBranch) || '';
print <<"EOT";
[INFO] Please enter a one line comment describing the changes on this branch.
To accept the comment entered at creation time, just press ENTER:
$comment
EOT
print "[COMMENT] ";
my $new = <STDIN>;
unless(defined $new) {
die "\nAborted.\n";
}
chomp $new;
if(length $new) {
$comment = $new;
}
}
$CCAPI->set_branch_comment(BRANCH => $TaskBranch, COMMENT => $comment);
# just mark the branch type as ready-for-delivery
$CCAPI->set_attribute_on_branch(BRANCH => $TaskBranch, ATTRIBUTE => 'TASK_STATE',
VALUE => 'ready');
# deliver quits here
return;
} # end deliver
# for following operations we'll need the integration branch
# in GUI mode, already defined
if(!$opt{notask} && !$Ibranch) {
$Ibranch = _get_integ_branch($TaskBranch, $opt{ibranch});
}
# show which merges are needed when integrating
# TODO this is not using the (integration) ACS
if(!$opt{notask} && $opt{show}) {
my $integ_cs = get_integ_config_spec($Ibranch);
unless($integ_cs && $CCAPI->set_config_spec(CONTENT => $integ_cs)) {
$Status = 1;
return;
}
$CCAPI->log_info(0, "\n[INFO] The following elements will require a merge during integration:\n");
# we want to see the progress, so run in system()
# TODO timestamp restriction?
my $fver = ($^O =~ /win/i) ? "...\\$TaskBranch\\LATEST" : ".../$TaskBranch/LATEST";
my ($stat,$out,$err) = cleartool(qw(findmerge -nc -avobs), -fver => $fver, qw(-print));
if($stat) {
$CCAPI->log_warn(0, "[ERROR] Findmerge command failed:\n$out$err\n");
} else {
$CCAPI->log_info(0, $out."<end of list>\n");
}
# restore config spec
unless($CCAPI->set_config_spec(CONTENT => $OLD_CS)) {
$Status = 1;
}
# quit
return;
}
# sanity check - no checkouts to current view
# for any of the following actions
my @checkouts = $CCAPI->get_view_checkouts();
if(@checkouts) {
if($opt{rebase}) {
if($opt{gui}) {
my $dlg = $MAINWINDOW->Dialog(-title => 'Warning', -text => "There are checkouts to the current view:\n".join("\n", @checkouts), -buttons => [qw(Continue Abort) ],
-default_button => 'Continue');
my $answ = $dlg->Show;
if($answ =~ /abort/i) {
$CCAPI->log_info(0, "[INFO] Rebase aborted.\n");
return;
}
} else { # no GUI
warn "[WARNING] There are checkouts to the current view:\n ".join("\n ",@checkouts)."\n";
print "\n[QUERY] Do you want to continue to rebase? [y/n] ";
my $answ = <STDIN>;
unless($answ && $answ =~ /[yj]/i) {
print "[INFO] Aborted.\n";
return;
}
}
} else {
$Status = 1;
$CCAPI->log_warn(0, "[ERROR] There are checkouts to the current view:\n ".join("\n ",@checkouts)."\n");
return;
}
}
# save current config spec
my $cs_old = $ENV{WORKAREA} ? "$ENV{WORKAREA}/config_spec.old" : "config_spec.old";
unless(open(CS, ">$cs_old")) {
$CCAPI->log_warn(0, "[ERROR] Cannot open file '$cs_old' for write: $!\n");
} else {
print CS $OLD_CS;
unless(close(CS)) {
$CCAPI->log_warn(0, "[ERROR] Cannot write file '$cs_old': $!\n");
} else {
$CCAPI->log_info(0, "[INFO] Old config spec saved to '$cs_old'.\n");
}
}
# poor man's integration
if(!$opt{notask} && $opt{integrate}) {
unless(_check_no_checkouts_on_branch($TaskBranch)) {
$Status = 1;
return;
}
# build the config spec
my $new_cs = get_integ_config_spec($Ibranch);
unless($new_cs && $CCAPI->set_config_spec(CONTENT => $new_cs)) {
$Status = 1;
return;
}
$OLD_CS = $new_cs;
# start the merge
$CCAPI->log_info(0, "[INFO] Starting integration merge...\n");
$CCAPI->findmerge_with_rfm(COMMENT => "integrating branch $TaskBranch",
OPTIONS => [ -fver => ".../$TaskBranch/LATEST" ]);
$CCAPI->log_info(0, "\n[INFO] Please review the integration results and check in.\n");
# finish when integrating
return;
}
# set the config spec
my $new_cs = join("\n", @config_spec)."\n";
unless($CCAPI->set_config_spec(CONTENT => $new_cs)) {
$Status = 1;
return;
}
$OLD_CS = $new_cs;
# create task branch
unless($opt{notask}) {
my $newbranch = $CCAPI->create_branch(BRANCH => $TaskBranch,
INTEGRATION_BRANCH => $Ibranch, COMMENT => $opt{comment});
if($newbranch<0) {
$CCAPI->log_warn(0, "[ERROR] Failed to create branch '$TaskBranch' in all VOB(s).\n");
$Status = 0;
return;
}
elsif($newbranch) {
$CCAPI->log_info(0, "[INFO] Created branch '$TaskBranch' in $newbranch VOB(s).\n");
}
}
# save the ACS definition
unless($opt{notask}) {
$CCAPI->set_branch_acs(BRANCH => $TaskBranch, ACS => $new_acs);
}
$CCAPI->log_info(0, "[INFO] Current view setup complete.\n");
#print "FINISH user=$user project=$project ACS=$acs REV=$rev\n";
#print "ACS:\n",Dumper($ACS),"\n\nCnD:\n",Dumper(\%CnD),"\n";
#print "CONFIG SPEC:\n", join("\n", @config_spec), "\n";
# full baseline labelling according to config spec
if($opt{fulllabel}) {
unless($CCAPI->lock_integration_branch(BRANCH => $Ibranch,
COMMENT => "Creating new fully labeled baseline")) {
$CCAPI->log_warn(0, "[ERROR] Cannot get lock on integration branch '$Ibranch', unable to create fully labeled baseline.\n");
return;
}
$CCAPI->log_info(0, "[INFO] Creating full baseline using ACS '$new_acs'...\n");
my %opts = (BRANCH => $Ibranch,
COMMENT => "Full baseline using ACS $new_acs");
if($opt{baseline}) {
$opts{LABEL} = $opt{baseline};
}
my $label = $CCAPI->create_full_baseline(%opts);
my $status = 1;
if($label) {
$CCAPI->log_info(0, "[INFO] Created full baseline '$label'.\n");
if($CCAPI->set_recommended_baseline(BRANCH => $Ibranch, LABEL => $label)) {
$CCAPI->log_info(0, "[INFO] Recommended full baseline '$label' on branch '$Ibranch'.\n");
} else {
$CCAPI->log_warn(0, "[ERROR] Could not recommend full baseline '$label' on branch '$Ibranch'.\n");
}
} else {
$CCAPI->log_warn(0, "[ERROR] Could not label full baseline.\n");
$status = 0;
}
$CCAPI->unlock_integration_branches();
$CCAPI->restore_locks_on_all_branches();
return $status;
}
# perform rebase
if(!$opt{notask} && $opt{rebase}) {
# TODO check the timestamps of the label types
# ...to detect whether attempting to rebase back in time
# reset task state
$CCAPI->set_attribute_on_branch(BRANCH => $TaskBranch,
ATTRIBUTE => 'TASK_STATE', VALUE => 'open');
# create temporary view
my $viewtag = "rebase.$User.$$";
unless($CCAPI->create_temporary_view(VIEWTAG => $viewtag)) {
$CCAPI->log_warn(0, "[ERROR] Cannot create temporary view for rebase.\n");
return;
}
# set config spec
$CSgen->config(TASK_BRANCH => undef);
my @r_cs = $CSgen->generate_CS(COMMENTS => [
"# temporary rebase CS based on ACS $new_acs"
]);
unless($CCAPI->set_config_spec(VIEW => $viewtag, CONTENT => join("\n", @r_cs, ''))) {
$CCAPI->log_warn(0, "[ERROR] Cannot set config spec\n");
return;
}
$CCAPI->log_info(0, "[INFO] Starting rebase merge...\n");
# TODO remove findmerge logs?
$CCAPI->findmerge_with_rfm(COMMENT => "rebasing from ACS $new_acs",
OPTIONS => [ '-element' => "brtype($TaskBranch)", '-ftag' => $viewtag ]);
my @cos = sort $CCAPI->get_view_checkouts();
if(@cos) {
$CCAPI->log_info(0, "\n[INFO] Rebase merge results are still checked out - please review and check in or cancel:\n ".join("\n ", @cos)."\n");
} else {
$CCAPI->log_info(0, "\n[INFO] Rebase completed without any checkouts.\n");
}
# remove temporary view
$CCAPI->log_info(0, "[INFO] Cleaning up temporary view...\n");
$CCAPI->remove_view(VIEWTAG => $viewtag);
}
$CCAPI->log_info(0, "[INFO] Finished.\n");
}
sub _get_project
{
my ($user) = @_;
my %args = ();
if($user) {
%args = (USER => $user);
}
my @projects = $CmDbClient->get_projects(%args);
# interactive query for project
my $tc = Term::Completion->new(
prompt => "Please choose a project: ",
validate => 'fromchoices',
choices => \@projects);
my $project = $tc->complete();
return $project;
}
sub _get_acs
{
my ($user,$project) = @_;
my %args = (PROJECT => $project);
if($user) {
$args{USER} = $user;
}
my @acses = $CmDbClient->get_ACS_list(%args);
# interactive query for project
my $tc = Term::Completion->new(
prompt => "Please choose an abstract config spec: ",
validate => 'fromchoices',
choices => \@acses);
my $acs = $tc->complete();
return $acs;
}
sub _get_rev
{
my ($user,$project,$acs) = @_;
my %args = (PROJECT => $project, ACS => $acs);
if($user) {
$args{USER} = $user;
}
my @revs = $CmDbClient->get_ACS_rev_list(%args);
# interactive query for project
my $tc = Term::Completion->new(
prompt => "Please choose the revision of the abstract config spec: ",
validate => 'fromchoices',
choices => \@revs);
my $rev = $tc->complete();
return $rev;
}
sub check_ibranch
{
# check the existence of the integ branch
my ($ibranch) = @_;
unless($CCAPI->check_branch(BRANCH => $ibranch)) {
$CCAPI->log_warn(0, "[ERROR] Integration branch type '$ibranch' does not exist in all VOBs.\n");
return;
}
$CCAPI->log_info(0, "[INFO] Getting branches from parent/integration branch '$ibranch'.\n");
return $CCAPI->get_child_branches(BRANCH => $ibranch);
}
sub get_integ_config_spec
{
my ($ibranch) = @_;
my $cs;
if($ibranch ne 'main') {
unless($CCAPI->check_branch(BRANCH => $ibranch)) {
$CCAPI->log_warn(0, "[ERROR] Integration branch '$ibranch' does not exist in all VOBs.\n");
return;
}
# TODO this could be different in the different VOBs,
# and we could build a config spec out of that easily:
# element <vob-tag>/... <label> -mkbranch <branch>
# element <vob-tag>/... /main/LATEST -mkbranch <branch>
my $ilabel = $CCAPI->get_branch_root_label(BRANCH => $ibranch);
unless($ilabel) {
$CCAPI->log_warn(0, "[ERROR] No root label defined on integration branch '$ibranch'.\n");
return;
}
$cs = $CCAPI->generate_simple_config_spec(LABEL => $ilabel, BRANCH => $ibranch);
} else {
# we integrate to main
$cs = $^O =~ /win/i ? <<"EOT"
# integration config spec - default
element * CHECKEDOUT
element * \\main\\LATEST
EOT
: <<"EOT";
# integration config spec - default
element * CHECKEDOUT
element * /main/LATEST
EOT
}
return $cs;
}
# TODO here we could add the commit counter, or move this to ccci
sub _commit
{
my $comment = $opt{comment};
unless(defined($comment) && length($comment)) {
if($opt{gui}) {
$CCAPI->log_warn("[WARNING] Please enter a comment in the comment field.\n");
return;
} else {
print "\nPlease enter a one-line comment:\n";
$comment = <STDIN>;
chomp $comment;
}
}
my @c_opt = $comment ? (COMMENT => $comment) : ();
$CCAPI->commit(@c_opt);
}
sub _check_no_checkouts_on_branch
{
my ($branch) = @_;
my @cos = $CCAPI->get_checkouts_on_branch(BRANCH => $branch);
if(@cos) {
$CCAPI->log_warn(0, "[ERROR] There are checkouts on the branch '$branch':\n ".join("\n ",@cos)."\n");
return;
}
1;
}
sub _get_integ_branch
{
my ($branch, $ibranch) = @_;
my $ib = $CCAPI->get_integration_branch(BRANCH => $branch);
if($ibranch) {
# integ branch was specified - overrides all
$CCAPI->log_info(0, "[INFO] Using given integration branch '$ibranch'.\n");
if($ib && $ibranch ne $ib) {
$CCAPI->log_warn(0, "[WARNING] Overriding integration branch definition ($ib).\n");
}
return $ibranch;
}
if($ib) {
$CCAPI->log_info(0, "[INFO] Integration branch for branch '$branch' is '$ib'.\n");
return $ib;
}
elsif($ENV{INTEGRATION_BRANCH}) {
$CCAPI->log_info(0, "[INFO] Using integration branch '$ENV{INTEGRATION_BRANCH}' from environment definition.\n");
return $ENV{INTEGRATION_BRANCH};
}
else {
$CCAPI->log_info(0, "[INFO] Using default integration branch 'main'.\n");
return 'main';
}
}
our $LogWindow;
our $My_TB_only = 0;
our $Acs_text = '';
our $Acs_use_user = 1;
our $acs_item;
our $acs_tree;
our %acs_expanded;
our $task_be;
sub _setup_gui
{
eval "use Tk; use Tk::Tree; use Tk::ROText; use Tk::BrowseEntry; use Tk::Dialog; use Tk::Adjuster;";
die $@ if $@;
# set up the Tk window
# application main window
$MAINWINDOW = MainWindow->new(-title => "smartCM workarea manager $VERSION");
$MAINWINDOW->geometry('900x700');
$MAINWINDOW->optionAdd('*BorderWidth' => 1);
$MAINWINDOW->protocol('WM_DELETE_WINDOW' => sub {
$Action = 'cancel';
$MAINWINDOW->destroy;
});
# View selection
# this also defines the config spec
my $view_f = $MAINWINDOW->Labelframe(-text => 'View selection');
$view_f->Optionmenu(
-options => \@VIEWS,
-command => sub { _view_selected(1) },
-variable => \$VIEW
)->pack(-side => 'left', -fill => 'x', -expand => 0);
$view_f->Button(-text => 'View CS', -command => \&_view_cs)->pack(-side => 'right');
$view_f->pack(-side => 'top', -anchor => 'nw', -fill => 'x', -expand => 0);
# get task branch
my $TaskBranches = {};
if($OLD_CS && $OLD_CS =~ /^\s*#\s+task branch:\s+(\S+)/m) {
$TaskBranch = $1;
}
elsif(!$TaskBranch) {
$TaskBranch = '-none-';
}
my $task_f = $MAINWINDOW->Labelframe(-text => 'Task branch');
$task_f->Checkbutton(-text => 'My TB only', -variable => \$My_TB_only,
-command => sub { $TaskBranches = +{}; })->pack(-side => 'left');
$task_be = $task_f->BrowseEntry(
-command => sub { _branch_selected(1) },
-background => 'white',
-width => 50,
-choices => ($Ibranch ? $TaskBranches->{$Ibranch} : []),
-listcmd => sub {
unless($Ibranch && $TaskBranches->{$Ibranch}) {
$Ibranch = 'main' unless $Ibranch;
$CCAPI->log_info(0, "[INFO] Getting child branches for '$Ibranch'... patience please...\n");
$MAINWINDOW->Busy(-recurse => 1);
$TaskBranches->{$Ibranch} = [ '-none-',
$CCAPI->get_child_branches(BRANCH => $Ibranch, $My_TB_only ? (USER => $User)
: ())];
$MAINWINDOW->Unbusy(-recurse => 1);
}
$task_be->configure(-choices => $TaskBranches->{$Ibranch});
1;
},
-variable => \$TaskBranch
);
$task_be->pack(-side => 'left');
$task_be->bind('<Key-Return>' => sub { _branch_selected(0) });
$task_f->Label(-text => 'Comment:')->pack(-side => 'left');
$task_f->Entry(-width => 50, -textvariable => \$opt{comment})
->pack(-side => 'left');
$task_f->pack(-side => 'top', -anchor => 'nw', -fill => 'x', -expand => 0);
# ACS selection
my $acs_f = $MAINWINDOW->Labelframe(-text => 'ACS selection');
my $acs_f2 = $acs_f->Frame();
$acs_f2->Checkbutton(-text => 'User:', -variable => \$Acs_use_user,
-command => \&_toggle_use_user)
->pack(-side => 'left');
my $acs_user_entry = $acs_f2->Entry(-width => 20,
-background => 'white', -textvariable => \$User);
$acs_user_entry->pack(-side => 'left');
$acs_user_entry->bind('<Key-Return>' => \&_init_acs_entries);
$acs_f2->pack(-side => 'top', -anchor => 'nw');
$acs_f2->Label(-text => 'ACS selected:')->pack(-side => 'left');
$acs_f2->Entry(-width => 40, -background => 'white',
-textvariable => \$Acs_text, -state => 'disabled')->pack(-side => 'left');
$acs_f2->Label(-text => 'Integ branch:')->pack(-side => 'left');
$acs_f2->Entry(-width => 40, -background => 'white',
-textvariable => \$Ibranch, -state => 'disabled')->pack(-side => 'left');
$acs_tree = $acs_f->Scrolled('Tree',
-scrollbars => 'osoe',
-background => 'white',
-itemtype => 'text',
-separator => '|',
-selectmode => 'single',
#-width => 30,
-browsecmd => \&_browse_acs_entry,
-opencmd => \&_open_acs_entry,
# -closecmd
-ignoreinvoke => 1
);
$acs_tree->pack(-side => 'top', -anchor => 'nw', -fill => 'both', -expand => 1);
$acs_f->pack(-side => 'top', -anchor => 'nw', -fill => 'both', -expand => 1);
# bind right-click to context menu
my $acs_context_menu = $MAINWINDOW->Menu(-tearoff => 0, -title => 'ACS menu',
-relief => 'raised', -menuitems => [
[ Button => "View", -command => \&_view_acs ],
[ Button => "Preview Config Spec", -command => \&_preview_cs ],
]
);
$acs_tree->bind('<Button-3>', sub {
# save the item in 'context' for the menu calls
$acs_item = $_[0]->nearest($_[0]->XEvent->y);
$acs_context_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
});
# log window
my $log_f = $MAINWINDOW->Labelframe(-text => 'Log');
$LogWindow = $log_f->Scrolled('ROText', -scrollbars => 'e', -height => 6);
$LogWindow->pack(-side => 'left', -fill => 'both', -expand => 1);
$log_f->pack(-side => 'bottom', -anchor => 'sw', -fill => 'x', -expand => 1);
my $adj2 = $MAINWINDOW->Adjuster;
$adj2->packAfter($log_f, -side => 'bottom');
# the actions
my $action_f = $MAINWINDOW->Labelframe(-text => 'Actions');
$action_f->Checkbutton(-text => 'Rebase', -variable => \$opt{rebase})
->pack(-side => 'left');
$action_f->Button(-text => 'Ok', -width => 8, -command =>
sub { $Action = 'ok'; _do_work(); })
->pack(-side => 'left');
$action_f->Button(-text => 'Show', -width => 8, -command =>
sub { $Action = 'show'; local $opt{show} = 1; _do_work(); })
->pack(-side => 'left');
$action_f->Button(-text => 'Deliver', -width => 8, -command =>
sub { $Action = 'deliver'; local $opt{deliver} = 1; _do_work(); })
->pack(-side => 'left');
$action_f->Button(-text => 'Commit', -width => 8, -command =>
sub { $Action = 'commit'; _commit(); })
->pack(-side => 'left');
#$action_f->Button(-text => 'Full Label', -command =>
# sub { $Action = 'fulllabel'; local $opt{fulllabel} = 1; _do_work(); })
# ->pack(-side => 'left');
$action_f->Button(-text => 'Quit', -width => 8, -command =>
sub { $Action = 'cancel'; $MAINWINDOW->destroy })
->pack(-side => 'right');
$action_f->pack(-side => 'bottom', -anchor => 'sw', -fill => 'x', -expand => 0);
1;
}
sub _log_gui
{
my ($msg) = @_;
$LogWindow->insert('end',$msg);
$LogWindow->yviewMoveto(1);
$LogWindow->update();
}
sub _view_cs
{
my $logwin = $MAINWINDOW->Toplevel(-title => 'Config spec viewer');
my $logtext = $logwin->Scrolled('ROText', -scrollbars => 'osoe');
$logtext->Contents($OLD_CS);
$logtext->pack(-side => 'top', -expand => 1, -fill => 'both');
# close button
$logwin->Button(-text => 'Close', -command => sub {
$logwin->destroy;
})->pack(-side => 'right', -anchor => 'se');
1;
}
sub _view_acs
{
return unless($acs_item && $acs_item =~ m{^server\|([^|]+)\|([^|]+)\|([^|]+)});
my ($project,$acs,$rev) = ($1,$2,$3);
if($acs =~ s{^(\w+)/}{}) {
$User = $1;
$Acs_use_user = 1;
} else {
$Acs_use_user = 0;
}
my $ACS_content = $CmDbClient->get_ACS(PROJECT => $project, ACS => $acs,
REV => $rev, ($Acs_use_user ? (USER => $User) : ()));
#my %ACS_content = (
#'cnd' => 's4g_main.HEAD',
# # domain # selector
#'component' => { 'tx' => { 'design' => 's4g_main.5',
# 'concept' => 's4g_main.HEAD',
# 'analog' => 's4g_main.LATEST' },
# 'rx' => { 'design' => 's4g_main.3',
# 'concept' => 's4g_main.HEAD',
# 'analog' => 's4g_main.LATEST' } },
# 'vobs' => { '//slc-S4G-prj' => 's4g_main.HEAD',
# '//slc-S4G-fe_dig' => 's4g_main.HEAD',
# '//smartilu-LUP-stools' => 's4g_main.HEAD' }
# );
my $logwin = $MAINWINDOW->Toplevel(-title => 'ACS viewer');
my $logtext = $logwin->Scrolled('ROText', -scrollbars => 'osoe');
delete $ACS_content->{_this};
$logtext->Contents(<<"EOT". Dump($ACS_content));
Project: $project
ACS: $acs
Revision: $rev
EOT
$logtext->pack(-side => 'top', -expand => 1, -fill => 'both');
my $adj = $logwin->Adjuster;
$adj->packAfter($logtext, -side => 'top');
# CnD
my $ACS_cnd = $ACS_content->getCnDSelector();
my $cndtext = $logwin->Scrolled('ROText', -scrollbars => 'osoe');
if($ACS_cnd && $ACS_cnd =~ /^([^.]+)\.([^.]+)$/) {
my $CnD_content = $CmDbClient->get_CnD(PROJECT => $project, REV => [ $1 => $2 ]);
delete $CnD_content->{_this};
$cndtext->Contents(Dump($CnD_content));
} else {
$cndtext->Contents("[ERROR] ACS does not contain a valid Component/Domain definition.\n");
}
$cndtext->pack(-side => 'top', -expand => 1, -fill => 'both');
# close button
$logwin->Button(-text => 'Close', -command => sub {
$logwin->destroy;
})->pack(-side => 'right', -anchor => 'se');
1;
}
sub _preview_cs
{
unless($Acs_text) {
$CCAPI->log_warn(0, "[ERROR] No valid ACS selected.\n");
return;
}
my $logwin = $MAINWINDOW->Toplevel(-title => "Preview Config Spec: $Acs_text");
my $logtext = $logwin->Scrolled('ROText', -scrollbars => 'osoe');
# ACS
my ($user,$project,$acs,$rev) = $CmDbClient->parse_acs_definition($Acs_text);
# get the ACS details
my $acs_obj = $CmDbClient->get_ACS(PROJECT => $project, ACS => $acs, REV => $rev,
($user ? (USER => $user) : ()) );
unless($acs_obj) {
$CCAPI->log_warn(0, "[ERROR] Cannot retrieve ACS '$Acs_text' from server.\n");
return;
}
# component and domain definitions
my ($ACS_cnd,$CnD_name, $CnD_rev);
$ACS_cnd = $acs_obj->getCnDSelector();
if($ACS_cnd && $ACS_cnd =~ /^([^.]+)\.([^.]+)$/) {
($CnD_name, $CnD_rev) = ($1,$2);
} else {
$CCAPI->log_warn(0, "[ERROR] ACS does not contain a valid Component/Domain definition.\n");
return;
}
my $CnD = $CmDbClient->get_CnD(PROJECT => $project,
REV => [ $CnD_name => $CnD_rev ]);
unless($CnD) {
$CCAPI->log_warn(0, "[ERROR] Cannot retrieve Component/Domain definition '$CnD_name.$CnD_rev' from server.\n");
return;
}
my @comments = ("# based on ACS $Acs_text ($opt{server})");
# integration branch
my $acs_ibranch = $acs_obj->getIntegrationBranch();
if($acs_ibranch) {
push(@comments, "# ACS defines integration branch '$Ibranch'");
} else {
$CCAPI->log_warn(0, "[WARNING] Cannot determine integration branch from ACS, falling back to '$Ibranch'.\n");
$acs_ibranch = $Ibranch;
}
# we may need a config spec include file
my ($inc_file, $inc_selector) = $acs_obj->getIncludeFileSelector;
# ... and we may have custom load rules for snapshop views
my @load_rules = $acs_obj->getCustomLoadRules;
my $CSgen = CSgen->new(ACS => $acs_obj, CND => $CnD,
INCLUDE_FILE => $inc_file, INCLUDE_SELECTOR => $inc_selector,
($opt{freeze} ? (TIMESTAMP => $opt{freeze}) : ()),
VERBOSITY => $opt{verbose},
($opt{gui} ? (LOG_INFO => \&_log_gui, LOG_WARN => \&_log_gui) : ()),
($opt{notask} ? () : (TASK_BRANCH => $TaskBranch)),
($CCAPI->is_snapshot_view(VIEW => $VIEW) ? (LOADRULES => \@load_rules) : ()),
);
my @config_spec = $CSgen->generate_CS(COMMENTS => \@comments);
$logtext->Contents(join("\n", @config_spec));
$logtext->pack(-side => 'top', -expand => 1, -fill => 'both');
# close button
$logwin->Button(-text => 'Close', -command => sub {
$logwin->destroy;
})->pack(-side => 'right', -anchor => 'se');
1;
}
sub _browse_acs_entry
{
my ($item) = @_;
# select the ACS
unless($item =~ m{^(server)(?:\|([^|]+)|)(?:\|([^|]+)|)(?:\|([^|]+)|)}) {
$CCAPI->log_warn(0, "[WARNING] Cannot parse item '$item'\n");
return;
}
my $server = $1;
my $project = $2;
my $acs_name = $3;
my $revision = $4;
if($acs_name && $acs_name =~ s{^(\w+)/}{}) {
$User = $1;
$Acs_use_user = 1;
} else {
$Acs_use_user = 0 if $acs_name;
}
if($server && $project && $acs_name && $revision) {
_set_acs($item,$project,$acs_name,$revision);
} else {
$opt{acs} = $Acs_text = '';
$Ibranch = '';
}
1;
}
sub _set_acs
{
my ($item,$project,$acs_name,$revision) = @_;
$acs_tree->selectionSet($item);
$opt{acs} = $Acs_text = $Acs_use_user ?
"$User\@$project:$acs_name#$revision" :
"$project:$acs_name#$revision";
my $ACS_content = $CmDbClient->get_ACS(PROJECT => $project, ACS => $acs_name,
REV => $revision, ($Acs_use_user ? (USER => $User) : ()));
if($ACS_content) {
my $ibranch = $ACS_content->getIntegrationBranch;
$Ibranch = $ibranch if $ibranch;
}
}
sub _init_acs_entries
{
$acs_tree->selectionClear;
$acs_tree->delete('all');
$acs_tree->add('server', -text => $opt{server});
$acs_tree->setmode('server' => 'open');
$acs_tree->update;
%acs_expanded = ();
}
sub _open_acs_entry
{
my ($item) = @_;
# remember cursor and block the GUI
my $Cursor = $MAINWINDOW->cget('-cursor');
$MAINWINDOW->Busy(-recurse => 1);
# get the object and get its children
unless($item =~ m{^(server)(?:\|([^|]+)|)(?:\|([^|]+)|)(?:\|([^|]+)|)}) {
$CCAPI->log_warn(0, "[WARNING] Cannot parse item '$item'\n");
return;
}
my $server = $1;
my $project = $2;
my $acs_item = my $acs_name = $3;
my $revision = $4;
if($acs_name && $acs_name =~ s{^(\w+)/}{}) {
$User = $1;
$Acs_use_user = 1;
} else {
$Acs_use_user = 0 if $acs_name;
}
if($acs_expanded{$item}++) {
foreach($acs_tree->info(children => $item)) {
$acs_tree->show(-entry => $_);
}
}
elsif(!$project) {
my @projects = $Acs_use_user ?
$CmDbClient->get_projects(USER => $User) :
$CmDbClient->get_projects();
foreach $project (@projects) {
my $path = "$server|$project";
$acs_tree->add($path, -text => $project) unless $acs_tree->info('exists', $path);
$acs_tree->setmode($path, 'open');
$acs_tree->show(-entry => $path);
}
if(@projects < 2) {
$acs_tree->setmode($item, 'none');
} else {
$acs_tree->setmode($item, 'close');
}
}
elsif(!$acs_name) {
my @acses = $Acs_use_user ?
$CmDbClient->get_ACS_list(USER => $User, PROJECT => $project) :
$CmDbClient->get_ACS_list(PROJECT => $project);
foreach $acs_name (@acses) {
my $path = "$server|$project|$acs_name";
$acs_tree->add($path, -text => $acs_name) unless $acs_tree->info('exists', $path);
$acs_tree->setmode($path, 'open');
$acs_tree->show(-entry => $path);
}
if(@acses < 2) {
$acs_tree->setmode($item, 'none');
} else {
$acs_tree->setmode($item, 'close');
}
}
elsif(!$revision) {
my @revs = $Acs_use_user ?
$CmDbClient->get_ACS_rev_list(USER => $User, PROJECT => $project,
ACS => $acs_name) :
$CmDbClient->get_ACS_rev_list(PROJECT => $project, ACS => $acs_name);
foreach $revision (@revs) {
my $path = "$server|$project|$acs_item|$revision";
$acs_tree->add($path, -text => $revision) unless $acs_tree->info('exists', $path);
$acs_tree->setmode($path, 'none');
$acs_tree->show(-entry => $path);
}
if(@revs < 2) {
$acs_tree->setmode($item, 'none');
} else {
$acs_tree->setmode($item, 'close');
}
}
$acs_tree->selectionClear;
$acs_tree->update();
$MAINWINDOW->Unbusy(-recurse => 1);
$MAINWINDOW->configure('-cursor' => $Cursor);
1;
}
sub _toggle_use_user
{
_init_acs_entries();
}
sub _view_selected
{
my ($gui) = @_;
$OLD_CS = $CCAPI->get_config_spec(VIEW => $VIEW);
return unless $OLD_CS;
my $old_tb = $TaskBranch;
if($OLD_CS =~ /^\s*#\s+task branch:\s+(\S+)/m) {
$TaskBranch = $1;
if($gui && $TaskBranch ne $old_tb) {
$task_be->update();
_branch_selected(1);
}
}
}
sub _branch_selected
{
my ($have_branch) = @_;
my ($acs,$u,$p,$a,$r);
if($TaskBranch eq '-none-') {
$opt{notask} = 1;
$opt{rebase} = 0;
$have_branch = 0;
}
elsif(!$CCAPI->check_branch_name(NAME => $TaskBranch)) {
$TaskBranch = '';
$opt{rebase} = 0;
$have_branch = 0;
return;
}
else {
$opt{notask} = 0;
my $c = $CCAPI->get_branch_comment(BRANCH => $TaskBranch);
$opt{comment} = $c if $c;
# get info whether branch exists, and set have_branch
$acs = $CCAPI->get_branch_acs(BRANCH => $TaskBranch);
if($acs) {
($u,$p,$a,$r) = $CmDbClient->parse_acs_definition($acs);
}
$have_branch = $a ? 1 : 0;
}
if($have_branch) {
$opt{rebase} = 1;
} else {
$opt{rebase} = 0;
}
# existing task branches with ACS should rebase
return unless $a;
_init_acs_entries();
my $item = 'server';
_open_acs_entry($item);
if($p && $acs_tree->info('exists', "$item|$p")) {
$item .= "|$p";
_open_acs_entry($item);
}
if($a && $acs_tree->info('exists', "$item|$a")) {
$item .= "|$a";
_open_acs_entry($item);
}
if($r && $acs_tree->info('exists', "$item|$r")) {
$item .= "|$r";
$acs_tree->selectionClear();
_set_acs($item,$p,$a,$r);
}
1;
}
__DATA__
package Term::Completion;
sub new
{
my ($class,%this) = @_;
return bless(\%this, $class);
}
sub complete
{
my $this = shift;
my @choices = @{$this->{choices}};
if(@choices) {
print $this->{prompt}, "\n\n";
pretty_print_list(@choices);
print "\n";
}
print $this->{prompt};
my $answer = <STDIN>;
chomp $answer;
return $answer;
}
my $rl_screen_width = 80;
sub pretty_print_list
{
my @list = @_;
return unless @list;
my ($lines, $columns, $mark, $index);
## find width of widest entry
my $maxwidth = 0;
grep(length > $maxwidth && ($maxwidth = length), @list);
$maxwidth++;
$columns = $maxwidth >= $rl_screen_width
? 1 : int($rl_screen_width / $maxwidth);
## if there's enough margin to interspurse among the columns, do so.
$maxwidth += int(($rl_screen_width % $maxwidth) / $columns);
$lines = int((@list + $columns - 1) / $columns);
$columns-- while ((($lines * $columns) - @list + 1) > $lines);
$mark = $#list - $lines;
local $\ = '';
for (my $l = 0; $l < $lines; $l++) {
for ($index = $l; $index <= $mark; $index += $lines) {
printf("%-$ {maxwidth}s", $list[$index]);
}
print $list[$index] if $index <= $#list;
print "\n\r";
}
}
1;
__END__
=head1 NAME
scwa - configure and manipulate a smartCM development workarea
=head1 SYNOPSIS
B<scwa> S<{ B<-help> | B<-man> | B<-setup> | B<-commit> | B<-gui> }>
B<scwa>
S<[ B<-acs> I<acs-spec> ]>
S<[ B<-baseline> I<label-name> ]>
S<[ B<-batch> I<jobs> ]>
S<[ B<-comment> I<comment-string> ]>
S<[ B<-deliver> | B<-fulllabel> | B<-integrate> | B<-obsolete> | B<-rebase> | B<-show> >
S<[ B<-freeze> I<timestamp> ]>
S<| B<-unlock> ]>
S<[ B<-ibranch> I<integ-branch-name> ]>
S<[ B<-iemail> I<address,...> ]>
S<[ B<-server> I<host:port> ]>
S<[ B<-timeout> I<minutes> ]>
S<[ B<-verbose> ... ]>
S<[ B<-view> I<view-tag> ]>
S<[ B<-vobs> I<vob-tag,vob-tag2,...> ]>
S<[ B<-notask> | I<branch-name> ]>
=head1 DESCRIPTION
B<scwa> is a script for generation of config specs for working on a
task branch. This allows to isolate the development (new feature,
fixing a bug, ...) from the main line on a stable basis, and later
integrate the changes into the integration branch. The script also
automates the creation of the corresponding branch
types in all related VOBs and allows to select the proper starting
point (baseline) by means of an ACS (abstract config spec).
The old config spec of the current view is saved to the file
F<config_spec.old> and the new config spec is set to the current view.
No checkouts are allowed in the current view when changing the config
spec, to avoid confusion and inconsistencies at check-in time. Check in
(using e.g. C<B<scwa> -commit>) or cancel your checkout before changing
your workarea configuration.
The script tries to correctly guess as much as possible the intended
parameters - the branch name from the currently set config spec, the
label from the parent integration branch attribute. You can always
override these guesses with the corresponding command line options.
With B<-gui>, the script starts up in a user-friendly GUI mode. It can be
run on the command line as well; when prompted to choose from a menu, you
can use command line completion features (on UNIX):
=over 4
=item *
Press TAB once to complete the name from the list of available names.
=item *
Press TAB twice (or CTRL-D once) to list all available choices.
=back
=head2 Branch Config Spec
Here is the typical structure of a config spec that uses a branch,
which is esentially what this script generates, along with creation
of the branch type:
element * CHECKEDOUT
element * .../<branch>/LATEST
mkbranch <branch>
element * <label>
element * /main/0
end mkbranch
=head2 Abstract Config Specs
To ease the configuration of workareas, the user chooses as basis
an "abstract config spec" (ACS). This describes on the level of
components and domains which version for each of these is to be
reflected in the workarea. The version selection is done with a
simple combination of branch and selector. This script expands these
definitions into a full ClearCase config spec that is then set in
the user's view.
All ACSes are hosted on a central server, which allows to maintain
the set of configurations. This script retrieves the ACS details
from the server and configures the ClearCase view accordingly.
The selected ACS is stored with each task branch (the
ACS attribute on the task branch type), such that
it is clearly documented how a branch is configured.
When creating a new task branch, you are interactively asked to
select the project, the ACS and its revision. You can also specify
it on the command line with the B<-acs> option. The syntax is
as follows:
<user>@<project>:<acs-name>#<revision>
=head2 Integration Branch Concept
If not specified with the B<-ibranch> option, the integration branch is
always "main". When creating a new task branch, the corresponding
parent or integration branch is stored with the task branch.
Thus the B<scwa> script knows on which parent branch to look for
rebase labels, and to which branch to deliver. When selecting a task
branch, only those are listed which belong to the integration branch.
=head1 OPTIONS
The single (optional) argument to this script is the branch name to use.
=over 4
=item B<-help>
Show a brief help message.
=item B<-man>
Show this detailed manual.
=item B<-setup>
The project administrator has to execute B<scwa -setup> once in the
project to create the required attribute types in all VOBs.
=item B<-commit>
This is a simple helper to checkin all current checkouts in the View.
Useful to prepare a test and delivery. No further actions are done.
=item B<-gui>
Start the script in GUI mode - a dialog box pops up that allows to
conveniently choose ACSes from a menu, select the task branch and
launch the various commands.
=item B<-acs> I<acs-specification>
This option allows to specify the (new) ACS to configure the task branch
with. See L<"Abstract Config Specs"> above for the syntax. If not specified,
the script queries for it interactively. See also L</-rebase> and
L</SMARTCM_PROJECT> below.
=item B<-baseline> I<label-name>
Only to be used with B<-fulllabel>: specify a custom baseline name.
By default it is derived from the C<BASELINE_COUNTER> attribute on the
integration branch.
=item B<-batch> I<number>
When processing the merges, run the commands with max I<number> of elements.
The default value is 200.
=item B<-comment> I<comment-string>
A one-line comment to be used for creating a new branch or for checkin comments
while merging. Will be queried interactively when needed and this option was
not specified.
=item B<-deliver>
This option should be used when the development and component test is
completed and the changes are ready for delivery. The B<scwa> script
marks the task branch with an attribute (TASK_STATE="ready") which
indicates to the C<scintegrate> script that the branch is ready for
integration. Do I<not> use this task branch any more, i.e. do not check
out. For further development, create a new task branch with B<scwa>.
Example:
scwa -deliver my_development_branch
=item B<-freeze> I<timestamp>
The ACS may contain the C</freeze> modifier in the selector; this
indicates (only in connection with C<LATEST>) that the latest version
from the given branch should be shown, but only until a certain time
stamp. When B<scwa> is called and generates a new config spec (for an
existing task branch typically during a rebase operation), it will use
the current time as the cutoff timestamp. With this option you can
specify another time stamp. Use the same syntax as documented in the
B<config_spec> manual page of ClearCase:
<mm>-<mon>-<year>.<hh>:<mm>[:ss] e.g. 01-Aug-2011.13:30
=item B<-fulllabel>
Set the config spec according to an ACS (a task branch may be specified,
or use B<-notask>, and apply recusively a new label to all VOBs. This
creates a full baseline on the integration branch, which is also
recommended as the "HEAD" baseline through the C<RECOMMENDED_LABEL>
attribute. The label name is either specified by the B<-baseline>
option, or automatically derived from the B<BASELINE_COUNTER> attribute
on the integration branch defined by the ACS.
=item B<-ibranch> I<integration-branch-name>
The integration branch to use for the (new) task branch. Default is
"main". See also L</INTEGRATION_BRANCH> below. In connection with B<-integrate>
an alternate integration or target delivery branch can be specified.
=item B<-iemail> I<address,...>
For the given task branch (I<not> the integration branch given by
B<-ibranch>), set the list of integrator email addresses. This list is used by
the B<scintegrate> script when integrating to this branch.
=item B<-integrate>
I<This option is deprecated. The integrator should use the B<scintegrate>
script to integrate changes from the task branches. This option may still be
used to deliver changes from the task branch to another task branch.>
Integration means merging the changes from a branch to the main development
line; by default, this is the C<main> branch. The config spec is set to the
integration branch, and the merge process from the task branch to the
current view is initiated. See also the comments above about the merge process
in the section on L</-rebase>.
=item B<-notask>
Do not create or use a task branch, but only set the config spec according
to the selected ACS.
=item B<-obsolete>
This option deactivates a task branch from further development. The task state
is set to "obsolete" and the branch types are locked obsolete. The branch will
not be listed in the version tree, the history and the B<cleartool lstype>
command any more. The data on the branch remains in the database and the lock
can be undone. Only the VOB owner is authorized to lock.
=item B<-rebase>
This option starts the I<rebase> process for an existing branch. The branch
name is guessed from the current config spec. The ACS to use is either taken
from the command line (B<-acs>) or from the ACS attribute on the task
branch, or you are prompted to select a new ACS interactively if none of the
above is defined. The config spec (and the ACS attribute) is updated
accordingly. The B<scwa> script updates the task branch with an attribute
(TASK_STATE="open") to document that the branch has been reopened for
development.
Finally a merge process is initiated to merge - where necessary - any changes
from the new ACS into the modified files on the branch. The merge process
leaves the files checked-out; this allows to review the rebase results and to
run any tests to verify the correctness of the merges (if any). By canceling
these checkouts the merge process is undone completely.
Example:
scwa -rebase [ -acs S4G:CV_RECOMMENDED ]
See the checkedout elements with:
cleartool lsco -cview -avob
=item B<-server> I<host:port>
Specify the host and port of the ACS server. See also L</ACS_SERVER> below.
=item B<-show>
Show which merges will be necessary when integrating the task branch to the
integration branch. No actual merges are performed. In contrast to
B<scintegrate>, this option uses a simple, C<E<lt>branchE<gt>/LATEST> config
spec for running the B<findmerge> command. This is a simple
way to see which elements have been modified on the task branch.
=item B<-timeout> I<minutes>
When executing request-for-mastership, wait not longer than the given number of
minutes for the arrival. The default value is 2.
=item B<-unlock>
This option is to be used standalone or together with B<-rebase> to reactivate
a locked (obsolete) task branch. Only the VOB owner is authorized to unlock.
=item B<-verbose>
Increase the verbosity of the output, i.e. print more (diagnostic) messages.
This option can be repeated several times, to increase the verbosity even
more.
=item B<-view> I<view-tag>
The script usually determines the View from the current working directory;
use this option to specify a particular View to use.
=item B<-vobs> I<tag1,tag2,...>
By default, the list of VOBs is determined from the standard ClearCase
environment variable C<CLEARCASE_AVOBS> and the VOB list from the ACS.
This option allows you to
specify a (shorter) list of VOBs. to process - i.e. where to create new
branch types in and perform merges.
=back
=head1 ENVIRONMENT
=over 4
=item INTEGRATION_BRANCH
This environment variable may be set to contain the default
integration branch. It has the same effect as the B<-ibranch>
option.
=item ACS_SERVER
The ACS server host:port to use. Default value is
C<lnzll03d.lnz.infineon.com:3200>.
=item SMARTCM_PROJECT
Use this environment variable to pre-define the project name
for selection of the ACS.
=back
=head1 FILES
=over 4
=item config spec include file
If this file exists, its contents are inserted right after the first
config spec line (C<element * CHECKEDOUT>) to allow for extra
customization of the generated config spec. This is only done for the
task branch config spec, not the integration ("main/LATEST") config
spec.
=back
=head1 INTERNALS
The script uses the following attributes (attached to the branch types in
each VOB) to manage the properties of a branch:
=over 4
=item ACS
When creating or rebasing the task branch, this attribute is created/updated
with the ACS definition for any further reference. This allows
to always reconstruct the branch config spec only from the branch name.
=item TASK_STATE
This attribute may take the values C<open>, C<ready>, C<rejected>, or
C<integrated>. The B<scwa> script sets the C<TASK_STATE> to
C<ready> when the script is run with the B<-deliver> option. This
indicates to the B<scintegrate> script that the task branch is ready for
delivery.
=item RECOMMENDED_LABEL
This attribute, which is attached to the integration branch (typically
"main"), contains the latest qualified and recommended baseline label name.
This describes the "HEAD" baseline on the integration branch and is the
default baseline for new task branches or the rebase operation.
=item INTEGRATION_BRANCH
This attribute is attached to the task branch type to store the default
integration branch with the task branch. Furthermore it should be attached
to label types to associate the label with an integration branch.
This attribute allows to identify all child branches of an integration
branch, as well as the default rebase labels.
=item VIEW_SETUP_UNIX
=item VIEW_SETUP_WINDOWS
These attributes are attached to the local replica object of the VOB to
describe the storage location ("@<stgloc-name>") or the host/path
combination ("<view-server-host>:<view-storage-path>") where to create
temporary views required for the rebase operation.
=back
=head1 SEE ALSO
L<scintegrate>, L<ccco>, L<ClearCase::CtCmd>, L<ClearCase::MtCmd>
=cut