lib/Clearcase/UCM/Baseline.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Baseline.pm,v $
   4
   5 Object oriented interface to UCM Streams
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.4 $
  18
  19 =item Created
  20
  21 Fri May 14 18:16:16 PDT 2010
  22
  23 =item Modified
  24
  25 $Date: 2011/11/15 01:59:07 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides access to information about Clearcase Elements.
  32
  33   my $stream= new Clearcase::UCM::Stream ($name, $pvob);
  34
  35 =head1 DESCRIPTION
  36
  37 This module implements a UCM Stream object
  38
  39 =head1 ROUTINES
  40
  41 The following routines are exported:
  42
  43 =cut
  44
  45 package Clearcase::UCM::Baseline;
  46
  47 use strict;
  48 use warnings;
  49
  50 use Carp;
  51
  52 use lib '../..';
  53
  54 use Clearcase;
  55 use Clearcase::Element;
  56 use Clearcase::UCM::Activity;
  57
  58 sub _processOpts (%) {
  59   my ($self, %opts) = @_;
  60
  61   my $opts;
  62
  63   foreach (keys %opts) {
  64     if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') {
  65       $opts .= "-$_ ";
  66     } elsif ($_ eq 'c' or $_ eq 'cfile') {
  67       $opts .= "-$_ $opts{$_}";
  68     } # if
  69   } # foreach
  70
  71
  72   return $opts;
  73 } # _processOpts
  74
  75 sub new ($$) {
  76   my ($class, $baseline, $pvob) = @_;
  77
  78 =pod
  79
  80 =head2 new
  81
  82 Construct a new Clearcase Stream object.
  83
  84 Parameters:
  85
  86 =for html <blockquote>
  87
  88 =over
  89
  90 =item stream name
  91
  92 Name of stream
  93
  94 =back
  95
  96 =for html </blockquote>
  97
  98 Returns:
  99
 100 =for html <blockquote>
 101
 102 =over
 103
 104 =item Clearcase Stream object
 105
 106 =back
 107
 108 =for html </blockquote>
 109
 110 =cut
 111
 112   my $self = bless {
 113     name => $baseline,
 114     pvob => Clearcase::vobtag $pvob,
 115   }, $class; # bless
 116
 117   return $self;
 118 } # new
 119
 120 sub name () {
 121   my ($self) = @_;
 122
 123 =pod
 124
 125 =head2 name
 126
 127 Returns the name of the stream
 128
 129 Parameters:
 130
 131 =for html <blockquote>
 132
 133 =over
 134
 135 =item none
 136
 137 =back
 138
 139 =for html </blockquote>
 140
 141 Returns:
 142
 143 =for html <blockquote>
 144
 145 =over
 146
 147 =item stream's name
 148
 149 =back
 150
 151 =for html </blockquote>
 152
 153 =cut
 154
 155   return $self->{name};
 156 } # name
 157
 158 sub pvob () {
 159   my ($self) = @_;
 160
 161 =pod
 162
 163 =head2 pvob
 164
 165 Returns the pvob of the stream
 166
 167 Parameters:
 168
 169 =for html <blockquote>
 170
 171 =over
 172
 173 =item none
 174
 175 =back
 176
 177 =for html </blockquote>
 178
 179 Returns:
 180
 181 =for html <blockquote>
 182
 183 =over
 184
 185 =item stream's pvob
 186
 187 =back
 188
 189 =for html </blockquote>
 190
 191 =cut
 192
 193   return $self->{pvob};
 194 } # pvob
 195
 196 sub create ($$;$$) {
 197   my ($self, $project, $pvob, $baseline, $opts) = @_;
 198
 199 =pod
 200
 201 =head2 create
 202
 203 Creates a new UCM Stream Object
 204
 205 Parameters:
 206
 207 =for html <blockquote>
 208
 209 =over
 210
 211 =item UCM Project (required)
 212
 213 UCM Project this stream belongs to
 214
 215 =item PVOB (Required)
 216
 217 Project Vob
 218
 219 =item baseline
 220
 221 Baseline to set this stream to
 222
 223 =item opts
 224
 225 Options: Additional options to use (e.g. -readonly)
 226
 227 =back
 228
 229 =for html </blockquote>
 230
 231 Returns:
 232
 233 =for html <blockquote>
 234
 235 =over
 236
 237 =item $status
 238
 239 Status from cleartool
 240
 241 =item @output
 242
 243 Ouput from cleartool
 244
 245 =back
 246
 247 =for html </blockquote>
 248
 249 =cut
 250
 251   # Fill in object members
 252   $self->{project}  = $project;
 253   $self->{pvob}     = $pvob;
 254
 255   # Fill in opts
 256   $opts ||= '';
 257   $opts .= " -baseline $baseline"
 258     if $baseline;
 259
 260   $self->{readonly} = $opts =~ /-readonly/;
 261
 262   # TODO: This should call the exists function
 263   # Return the stream name if the stream already exists
 264   my ($status, @output) =
 265     $Clearcase::CC->execute ('lsstream -short ' . $self->{name});
 266
 267   return ($status, @output)
 268     unless $status;
 269
 270   # Need to create the stream
 271   return $Clearcase::CC->execute
 272     ("mkstream $opts -in " . $self->{project} .
 273      "\@"                  . $self->{pvob}    .
 274      ' '                   . $self->{name});
 275 } # create
 276
 277 sub remove (\%) {
 278   my ($self, %opts) = @_;
 279
 280 =pod
 281
 282 =head2 remove
 283
 284 Removes UCM Baseline
 285
 286 Parameters:
 287
 288 =for html <blockquote>
 289
 290 =over
 291
 292 =item none
 293
 294 =item %opts
 295
 296 Options: Additional options to use (e.g. -c, -force, etc.)
 297
 298 =back
 299
 300 =for html </blockquote>
 301
 302 Returns:
 303
 304 =for html <blockquote>
 305
 306 =over
 307
 308 =item nothing
 309
 310 Remember to check status method for error, and/or output method for output.
 311
 312 =back
 313
 314 =for html </blockquote>
 315
 316 =cut
 317
 318   my $opts = $self->_processOpts (%opts);
 319
 320   my $pvob = Clearcase::vobtag ($self->{pvob});
 321
 322   my ($status, @output) = $Clearcase::CC->execute
 323     ("rmbl $opts " . $self->{name} . '@' . $pvob);
 324
 325   return;
 326 } # remove
 327
 328 sub attributes () {
 329   my ($self) = @_;
 330
 331 =pod
 332
 333 =head2 attributes
 334
 335 Returns a hash of the attributes associated with a baseline
 336
 337 Parameters:
 338
 339 =for html <blockquote>
 340
 341 =over
 342
 343 =item none
 344
 345 =back
 346
 347 =for html </blockquote>
 348
 349 Returns:
 350
 351 =for html <blockquote>
 352
 353 =over
 354
 355 =item %attributes
 356
 357 Hash of attributes for this baseline
 358
 359 =back
 360
 361 =for html </blockquote>
 362
 363 =cut
 364
 365   return $self->Clearcase::attributes (
 366     'baseline',
 367     "$self->{name}\@" . Clearcase::vobtag ($self->{pvob})
 368   );
 369 } # attributes
 370
 371 sub diff ($;$$) {
 372   my ($self, $type, $baseline, %opts) = @_;
 373
 374 =pod
 375
 376 =head2 diff
 377
 378 Returns a hash of information regarding the difference between two baselines or
 379 a baseline and the stream (AKA "top of stream").
 380
 381 Parameters:
 382
 383 =for html <blockquote>
 384
 385 =over
 386
 387 =item [activities|versions|baselines]
 388
 389 Must specify one of [activities|versions|baselines]. Information will be
 390 returned based on this parameter.
 391
 392 =item $baseline or $stream
 393
 394 Specify the baseline or stream to compare to. If not specified a -predeccsor
 395 diffbl will be done. If a stream use "stream:<stream>" otherwise use
 396 "baseline:<baseline>" or simply "<baseline>".
 397
 398 =item %opts
 399
 400 Additional options.
 401
 402 =back
 403
 404 =for html </blockquote>
 405
 406 Returns:
 407
 408 =for html <blockquote>
 409
 410 =over
 411
 412 =item %info
 413
 414 Depending on whether activites, versions or baselines were specified, the
 415 returned hash will be constructed with the key being the activity, version
 416 string or baseline name as the key with additional information specified as the
 417 value.
 418
 419 =back
 420
 421 =for html </blockquote>
 422
 423 =cut
 424
 425   unless ($type =~ /^activities$/i or
 426           $type =~ /^versions$/i   or
 427           $type =~ /^baselines$/i) {
 428     croak "Type must be one of activities, versions or baselines in "
 429         . "Clearcase::UCM::Baseline::diff - not $type";
 430   } # unless
 431
 432   my $myBaseline = "$self->{name}\@$self->{pvob}";
 433
 434   my $cmd = "diffbl -$type";
 435
 436   if ($baseline) {
 437     if ($baseline =~ /(\S+):/) {
 438       unless ($1 eq 'baseline' or $1 eq 'stream') {
 439         croak "Baseline should be baseline:<baseline> or stream:<stream> or "
 440             . "just <baseline>";
 441       } # unless
 442     } # if
 443
 444     $baseline .= "\@$self->{pvob}" unless $baseline =~ /\@/;
 445
 446     $cmd .= " $myBaseline $baseline";
 447   } else {
 448     $cmd .= " -predeccsor";
 449   } # if
 450
 451   $Clearcase::CC->execute ($cmd);
 452
 453   return if $Clearcase::CC->status;
 454
 455   my @output = $Clearcase::CC->output;
 456
 457   my %info;
 458
 459   foreach (@output) {
 460     next unless /^(\>\>|\<\<)/;
 461
 462     if (/(\>\>|\<\<)\s+(\S+)\@/) {
 463       $info{$2} = Clearcase::UCM::Activity->new ($2, $self->{pvob});
 464     } # if
 465   } # foreach
 466
 467   return %info;
 468 } # diff
 469
 470 1;
 471
 472 =head1 DEPENDENCIES
 473
 474 =head2 ClearSCM Perl Modules
 475
 476 =for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
 477
 478 =head1 INCOMPATABILITIES
 479
 480 None
 481
 482 =head1 BUGS AND LIMITATIONS
 483
 484 There are no known bugs in this module.
 485
 486 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 487
 488 =head1 LICENSE AND COPYRIGHT
 489
 490 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
 491
 492 =cut